function [x,g,xn,gg] = kmeanhar(d,k,l,e,x0)
%KMEANS Vector quantisation using K-harmonic means algorithm [X,G,XN,GG]=(D,K,L,E,X0)
%
%  Inputs:
%
%    D(N,P)  contains N data vectors of dimension P
%    K       is number of centres required
%    L       integer portion is max loop count, fractional portion
%            gives stopping threshold as fractional reduction in performance criterion
%    E       is exponent in the cost function. Significantly faster if this is an even integer. [default 4]
%    X0(K,P) are the initial centres (optional)
%            Alternatively, X0 can be a character determining the initialization method:
%                'f'    Initialize with K randomly selected data points [default]
%                'p'    Initialize with centroids and variances of random partitions
%
%  Outputs:
%
%    X(K,P)  is output row vectors
%    G       is the final performance criterion value (normalized by N)
%    XN      nearest centre for each input point
%    GG(L+1) value of performance criterion before each iteration and at end
%
% The k-harmonic means algorithm selects K cluster centres to minimize
%                           sum_n(K/sum_k((d_n-x_k)^-e))
% where sum_n is over the N inputs points d_n and sum_k is over the K cluster centres x_k.
%
% It is often a good idea to scale the input data so that it has equal variance in each
% dimension before calling KMEANHAR so that approximately equal weight is given
% to each dimension in the distance calculation.

%  [1] Bin Zhang, "Generalized K-Harmonic Means - Boosting in Unsupervised Learning",
%      Hewlett-Packartd Labs, Technical Report HPL-2000-137, 2000 [Zhang2000]
%      http://www.hpl.hp.com/techreports/2000/HPL-2000-137.pdf

%  Bugs:
%      (1) Could use nested blocking to allow very large data arrays
%      (2) Could then allow incremental calling with partial data arrays (but messy)

%      Copyright (C) Mike Brookes 1998
%      Version: $Id: kmeanhar.m,v 1.6 2008/06/02 07:20:52 dmb Exp $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   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 2 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 can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% sort out the input arguments

if nargin<5
    x0='f';
    if nargin<4
        e=[];
        if nargin<3
            l=[];
        end
    end
end
if isempty(e)
    e=4;  % default value
end
if isempty(l)
    l=50+1e-3; % default value
end
sd=5;       % number of times we must be below threshold

% split into chunks if there are lots of data points

memsize=voicebox('memsize');
[n,p] = size(d);
nb=min(n,max(1,floor(memsize/(8*p*k))));    % block size for testing data points
nl=ceil(n/nb);                  % number of blocks

% initialize if X0 argument is not supplied

if ischar(x0)
    if k<n
        if any(x0=='p')                  % Initialize using a random partition
            ix=ceil(rand(1,n)*k);       % allocate to random clusters
            ix(rnsubset(k,n))=1:k;      % but force at least one point per cluster
            x=zeros(k,p);
            for i=1:k
                x(i,:)=mean(d(ix==i,:),1);
            end
        else                                % Forgy initialization: choose k random points [default]
            x=d(rnsubset(k,n),:);         % sample k centres without replacement
        end
    else
        x=d(mod((1:k)-1,n)+1,:);    % just include all points several times
    end
else
    x=x0;
end
eh=e/2;
th=l-floor(l);
l=floor(l)+(nargout>1);   % extra loop needed to calculate final performance value
if l<=0
    l=100;      % max number of iterations ever
end
if th==0
    th=-1;      % prevent any stopping if l has no fractional part
end
gg=zeros(l+1,1);
im=repmat(1:k,1,nb); im=im(:);

% index arrays for replication

wk=ones(k,1);
wp=ones(1,p);
% wn=ones(1,n);
%
% % Main calculation loop
%
% We have the following relationships to [1] where i and k index
% the data values and cluster centres respectively:
%
%   This program     [Zhang2000]                            Equation
%
%     d(i,:)            x_i                                 input data
%     x(k,:)            m_k                                 cluster centres
%     py(k,i)           (d_ik)^2
%     dm(i)'            d_i,min^2
%     pr(k,i)           (d_i,min/d_ik)^2
%     pe(k,i)           (d_i,min/d_ik)^p                    (7.6)
%     qik(k,i)          q_ik                                (7.2)
%     qk(k)             q_k                                 (7.3)
%     qik(k,i)./qk(k)   p_ik                                (7.4)
%     se(i)'            d_i,min^p * sumk(d_ik^-p)
%     xf(i)'            d_i,min^-2 / sumk(d_ik^-p)
%     xg(i)'            d_i,min^-(p+2) / sumk(d_ik^-p)^2

ss=sd+1;        % one extra loop at the start
g=0;                % dummy initial value of g
xn=zeros(n,1);
for j=1:l

    g1=g;                           % save old performance
    x1=x;                           % save old centres
    % first do partial chunk

    jx=n-(nl-1)*nb;
    ii=1:jx;
    kx=repmat(ii,k,1);
    km=repmat(1:k,1,jx);
    py=reshape(sum((d(kx(:),:)-x(km(:),:)).^2,2),k,jx);
    [dm,xn(ii)]=min(py,[],1);                 % min value in each column gives nearest centre
    dmk=dm(wk,:);                   % expand into a matrix
    dq=py>dmk;                      % update only these values
    pr=ones(k,jx);                   % leaving others at 1
    pr(dq)=dmk(dq)./py(dq);            % ratio of min(py)./py
    pe=pr.^eh;
    se=sum(pe,1);
    xf=dm.^(eh-1)./se;
    g=xf*dm.';                     % performance criterion (divided by k)
    xg=xf./se;
    qik=xg(wk,:).*pe.*pr;           % qik(k,i) is equal to q_ik in [Zhang2000]
    qk=sum(qik,2);
    xs=qik*d(ii,:);
    ix=jx+1;
    for il=2:nl
        jx=jx+nb;        % increment upper limit
        ii=ix:jx;
        kx=ii(wk,:);
        py=reshape(sum((d(kx(:),:)-x(im,:)).^2,2),k,nb);
        [dm,xn(ii)]=min(py,[],1);                 % min value in each column gives nearest centre
        dmk=dm(wk,:);                   % expand into a matrix
        dq=py>dmk;                      % update only these values
        pr=ones(k,nb);                   % leaving others at 1
        pr(dq)=dmk(dq)./py(dq);            % ratio of min(py)./py
        pe=pr.^eh;
        se=sum(pe,1);
        xf=dm.^(eh-1)./se;
        g=g+xf*dm.';                     % performance criterion (divided by k)
        xg=xf./se;
        qik=xg(wk,:).*pe.*pr;           % qik(k,i) is equal to q_ik in [Zhang2000]
        qk=qk+sum(qik,2);
        xs=xs+qik*d(ii,:);
        ix=jx+1;
    end
    gg(j)=g;
    x=xs./qk(:,wp);
    if g1-g<=th*g1
        ss=ss-1;
        if ~ss break; end  %  stop if improvement < threshold for sd consecutive iterations
    else
        ss=sd;
    end
end
gg=gg(1:j)*k/n;                       % scale and trim the performance criterion vector
g=g(end);
% gg' % *** DEBUIG ***
if nargout>1
    x=x1;                               % go back to the previous x values if G and/or XN value is output
end


function lengths = meshEdgeLength(vertices, edges, faces) %#ok<INUSD>
%MESHEDGELENGTH Lengths of edges of a polygonal or polyhedral mesh
%
%   output = meshEdgeLength(V, E, F)
%
%   Example
%   meshEdgeLength
%
%   See also
%
%
% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2010-10-04,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2010 INRA - Cepia Software Platform.

% extract vertices
p1 = vertices(edges(:, 1), :);
p2 = vertices(edges(:, 2), :);

% compute euclidean distance betwenn the two vertices
lengths = sqrt(sum((p2-p1).^2, 2));


function plotSDCon(sdcone,data)
%PLOTSDCON Plot Semidefinite Constraints on the current figure
%   plotSDCon(sdcone)

%   Copyright (C) 2013 Jonathan Currie (I2C2)

xl = xlim; yl = ylim;
hold on;

%Colour
dkr = [179/255 0.0 70/255];

%Determine number of quad constraints
if(iscell(sdcone))
    no = length(sdcone);
else
    no = 1;
end
%Generate Constraint Surface Points
[x1,x2] = meshgrid(linspace(xl(1),xl(2),data.npts),linspace(yl(1),yl(2),data.npts));

%For each semidefinite constraint, plot
for i = 1:no
    %Get Constraint Variables & Form Constraint Function
    if(iscell(sdcone))
        m = sqrt(size(sdcone{i},1));
        C = reshape(sdcone{i}(:,1),m,m); A0 = reshape(sdcone{i}(:,2),m,m);
        switch(data.ndec)
            case 1
                con = @(x) min(eig(A0*x(1) - C));
            case 2
                A1 = reshape(sdcone{i}(:,3),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) - C));
            case 3
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) - C));
            case 4
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                A3 = reshape(sdcone{i}(:,5),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) - C));
            case 5
                A1 = reshape(sdcone{i}(:,3),m,m); A2 = reshape(sdcone{i}(:,4),m,m);
                A3 = reshape(sdcone{i}(:,5),m,m); A4 = reshape(sdcone{i}(:,6),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) + A4*x(5) - C));
            otherwise
                error('Plotting Semidefinite constraints up to 5D is only supported');
        end
    else
        m = sqrt(size(sdcone,1));
        C = reshape(sdcone(:,1),m,m);
        A0 = reshape(sdcone(:,2),m,m);
        switch(data.ndec)
            case 1
                con = @(x) min(eig(A0*x(1) - C));
            case 2
                A1 = reshape(sdcone(:,3),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) - C));
            case 3
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) - C));
            case 4
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                A3 = reshape(sdcone(:,5),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) - C));
            case 5
                A1 = reshape(sdcone(:,3),m,m);
                A2 = reshape(sdcone(:,4),m,m);
                A3 = reshape(sdcone(:,5),m,m);
                A4 = reshape(sdcone(:,6),m,m);
                con = @(x) min(eig(A0*x(1) + A1*x(2) + A2*x(3) + A3*x(4) + A4*x(5) - C));
            otherwise
                error('Plotting Semidefinite constraints up to 5D is only supported');
        end
    end
    %Plot Each Quad Con as General Nonlinear Constraint
    plotNLCon(con,[],1e-6,Inf,x1,x2,dkr,data);
end
hold off;

% OLD CODE
% %Plot Semidefinite Constraints (Inefficient.. ideas appreciated!)
% [x1,x2] = meshgrid(linspace(xl(1),xl(2),npts),linspace(yl(1),yl(2),npts));
% nox = size(x1);
% noy = size(x2);
% obj = zeros(nox(1),noy(2));
% if(iscell(sdcone))
%     no = length(sdcone);
% else
%     no = 1;
% end
% for i = 1:no
%     %get vars
%     if(iscell(sdcone))
%         C = sdcone{i}(:,1); A0 = sdcone{i}(:,2); A1 = sdcone{i}(:,3);
%     else
%         m = sqrt(size(sdcone,1));
%         C = reshape(sdcone(:,1),m,m);
%         A0 = reshape(sdcone(:,2),m,m);
%         A1 = reshape(sdcone(:,3),m,m);
%     end
%     % create surface
%     for n = 1:nox(1)
%         for m = 1:noy(2)
%             obj(n,m) = min(eig(A0*x1(n,m) + A1*x2(n,m) - C));
%         end
%     end
%     c = contour(x1,x2,obj,'color',dkr,'levellist',0);
%     %Plot Hatch
%     if(~isempty(c))
%         %See if we have multiple contours (non-convex or sd)
%         len = size(c,2)-1;
%         if(c(2,1) ~= len)
%             %Build contour array
%             cstrt = 2; cend = []; n = 2; ind = 1;
%             while(ind <= len)
%                 ind = ind + c(2,ind) + 1;
%                 cend(n-1) = ind-1; %#ok<AGROW>
%                 cstrt(n) = ind+1;  %#ok<AGROW>
%                 n = n + 1;
%             end
%         else
%             cstrt = 2;
%             cend = len;
%         end
%         %Plot each contour hatch
%         for n = 1:length(cend)
%             %Get contour vectors
%             vecx = diff(c(1,cstrt(n):cend(n)));
%             vecy = diff(c(2,cstrt(n):cend(n)));
%             if(isempty(vecx) || isempty(vecy))
%                 continue;
%             end
%             %Rotate hatch lines based on infeasible region
%             xt = [c(1,cstrt(n))+vecy(1) c(2,cstrt(n))-vecx(1)]'; %check rotated -90
%             fval = all(eig(A0*xt(1) + A1*xt(2) - C) >= 1e-6);
%             if(fval) %rotate 90
%                 hvecx = -vecy;
%                 hvecy = vecx;
%             else %rotate -90
%                 hvecx = vecy;
%                 hvecy = -vecx;
%             end
%             %Normalize
%             av = mean(sqrt(hvecx.^2 + hvecy.^2));
%             dirs = atan2(hvecy,hvecx);
%             hvecx = av*cos(dirs);
%             hvecy = av*sin(dirs);
%             %Shift origin
%             hvecx = c(1,cstrt(n):cend(n)-1) + hvecx;
%             hvecy = c(2,cstrt(n):cend(n)-1) + hvecy;
%             %Plot
%             line([c(1,cstrt(n):cend(n)-1)' hvecx']',[c(2,cstrt(n):cend(n)-1)' hvecy']','Color',dkr)
%         end
%     else
%         optiwarn('opti:plot','Cannot plot semidefinite constraint as contour data is empty!');
%     end
% end
%
% hold off;


function [mps] = mach2mps(mach)
% Convert speed from mach (at standard temperature and pressure!) to
% meters per second.
% Chad A. Greene 2012
mps = mach*343;


function f = createConvexHullMethod(p,xL,xU)

if ~isa(p.properties.derivative,'function_handle')
    f = [];
    return
end

if isa(p.properties.convexity,'char') && ~(isequal(p.properties.convexity,'none'))
    vexity = p.properties.convexity;
elseif isa(p.properties.convexity,'function_handle')
    % User-supplied method to derive convexity in region
    vexity = p.properties.convexity(xL,xU);
elseif ~isempty(p.properties.inflection)
    % Derive convexity by information about inflection
    vexity = DeriveVexityFromInflection(p.properties,xL,xU);
else
    vexity = 'none';
end

if isequal(vexity,'convex')
    if strcmpi(p.fcn,'blackbox')
        f0 = @(x)real(blackbox(x,p.arg{2}));
    else
        f0 = @(x)real(eval([p.fcn '(x)']));
    end
    f = @(xL,xU)createConvexHullMethodConvex(xL,xU,f0,p.properties.derivative);
elseif isequal(vexity,'concave')
    f0 = @(x)real(eval([p.fcn '(x)']));
    f = @(xL,xU)createConvexHullMethodConcave(xL,xU,f0,p.properties.derivative);
else
    f = [];
end


function [ mapX, mapY ] = WarpRegion( xmin, ymin, mask, triX, coeffs )
%WARPREGION Summary of this function goes here
%   Detailed explanation goes here

    %%
    [h, w] = size(mask);
    mapX = zeros(size(mask));
    mapY = zeros(size(mask));

    ys = [1:h]' * ones(1, w) + ymin - 1;
    xs = ([1:w]' * ones(1, h))' + xmin - 1;

    for t=0:size(coeffs,1)-1

        trimap = triX == t;

        a = coeffs(t+1,:);

        xo = a(1) + a(2) * xs + a(3) * ys;

        mapX(trimap) = xo(trimap);

        yo = a(4) + a(5) * xs + a(6) * ys;
        mapY(trimap) = yo(trimap);

    end

    mapX(~mask) = -1;
    mapY(~mask) = -1;

    %%
%     [h, w] = size(mask);
%     mapX_2 = zeros(size(mask));
%     mapY_2 = zeros(size(mask));
%
%     ys = [1:h]' * ones(1, w) + ymin - 1;
%     xs = ([1:w]' * ones(1, h))' + xmin - 1;
%
%     ys = ys(:);
%     xs = xs(:);
%
%     xos = coeffs(1,:) + bsxfun(@times, coeffs(2,:), xs) + bsxfun(@times, coeffs(3,:), ys);
%     yos = coeffs(4,:) + bsxfun(@times, coeffs(5,:), xs) + bsxfun(@times, coeffs(6,:), ys);
%
%     maps = repmat(trimap(:),1, size(coeffs,1));
%     maps = repmat

end


function G =  getGroupOverlapColor(row, col)

    N = row*col;

    g = sparse(zeros(N,1));
    g = diag(g);

    %% build overlapping group

    % top let corner group

    g(1, 1 ) = 1;
    g(1, 2 ) = 1;
    g(1, 1+row ) = 1;
    g(1, 2+row ) = 1;

     % bottom let corner group

    g(row, row-1 ) = 1;
    g(row, row ) = 1;
    g(row, row-1+row ) = 1;
    g(row, row+row ) = 1;

    % top right corner group

    g((col-1)*row+1, (col-1)*row+1 ) = 1;
    g((col-1)*row+1, (col-2)*row+1 ) = 1;
    g((col-1)*row+1, (col-1)*row+2 ) = 1;
    g((col-1)*row+1, (col-2)*row+2 ) = 1;

    % bottom right corner group

    g((col-1)*row+row , (col-1)*row+row-1 ) = 1;
    g((col-1)*row+row , (col-2)*row+row-1 ) = 1;
    g((col-1)*row+row , (col-1)*row+row ) = 1;
    g((col-1)*row+row , (col-2)*row+row ) = 1;

    % boundary group

    for i=2:col-1
        % top row rgoup

        j = 1;

        g( (i-1)*row+j  , (i-2)*row+j   ) = 1;
        g( (i-1)*row+j  , (i-2)*row+j+1 ) = 1;

        g( (i-1)*row+j  , (i-1)*row+j   ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j+1 ) = 1;

        g( (i-1)*row+j  , i*row+j   ) = 1;
        g( (i-1)*row+j  , i*row+j+1 ) = 1;

        % bottom row group

        j = row;

        g( (i-1)*row+j  , (i-2)*row+j-1 ) = 1;
        g( (i-1)*row+j  , (i-2)*row+j   ) = 1;

        g( (i-1)*row+j  , (i-1)*row+j-1 ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j   ) = 1;

        g( (i-1)*row+j  , i*row+j-1 ) = 1;
        g( (i-1)*row+j  , i*row+j   ) = 1;

    end

    for j=2:row-1
          % left column rgoup

        i=1;

        g( (i-1)*row+j  , (i-1)*row+j-1 ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j   ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j+1 ) = 1;
        g( (i-1)*row+j  , i*row+j-1 ) = 1;
        g( (i-1)*row+j  , i*row+j   ) = 1;
        g( (i-1)*row+j  , i*row+j+1 ) = 1;

        % right  column group

        i=col;

        g( (i-1)*row+j  , (i-2)*row+j-1 ) = 1;
        g( (i-1)*row+j  , (i-2)*row+j   ) = 1;
        g( (i-1)*row+j  , (i-2)*row+j+1 ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j-1 ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j   ) = 1;
        g( (i-1)*row+j  , (i-1)*row+j+1 ) = 1;

    end

    for i=2:col-1
        for j=2:row-1

            g( (i-1)*row+j  , (i-2)*row+j-1 ) = 1;
            g( (i-1)*row+j  , (i-2)*row+j   ) = 1;
            g( (i-1)*row+j  , (i-2)*row+j+1 ) = 1;
            g( (i-1)*row+j  , (i-1)*row+j-1 ) = 1;
            g( (i-1)*row+j  , (i-1)*row+j   ) = 1;
            g( (i-1)*row+j  , (i-1)*row+j+1 ) = 1;
            g( (i-1)*row+j  , i*row+j-1 ) = 1;
            g( (i-1)*row+j  , i*row+j   ) = 1;
            g( (i-1)*row+j  , i*row+j+1 ) = 1;

        end
    end

    G = sparse(3*N, 3*N);

    G(1:N, 1:N) = g;
    G(N+1:2*N, N+1:2*N) =g;
    G(2*N+1:3*N, 2*N+1:3*N) =g;

    % G =[g; g; g];

end


function res = chowlin_co_W(Y,x,ta,sc,opC)
% PURPOSE: Temporal disaggregation using the Chow-Lin method
%         (quarterly rho derived from Cochrane-Orcutt annual rho)
%          Without pretesting for intercept
% ------------------------------------------------------------
% SYNTAX: res = chowlin_co_W(Y,x,ta,sc,opC);
% ------------------------------------------------------------
% OUTPUT: res: a structure
%           res.meth    ='Chow-Lin';
%           res.ta      = type of disaggregation
%           res.type    = method of estimation
%           res.N       = nobs. of low frequency data
%           res.n       = nobs. of high-frequency data
%           res.pred    = number of extrapolations
%           res.sc       = frequency conversion between low and high freq.
%           res.p       = number of regressors (including intercept)
%           res.Y       = low frequency data
%           res.x       = high frequency indicators
%           res.y       = high frequency estimate
%           res.y_dt    = high frequency estimate: standard deviation
%           res.y_lo    = high frequency estimate: sd - sigma
%           res.y_up    = high frequency estimate: sd + sigma
%           res.u       = high frequency residuals
%           res.U       = low frequency residuals
%           res.beta    = estimated model parameters
%           res.beta_sd = estimated model parameters: standard deviation
%           res.beta_t  = estimated model parameters: t ratios
%           res.rho     = innovational parameter
%           res.aic     = Information criterion: AIC
%           res.bic     = Information criterion: BIC
%           res.co      = Cochrane-Orcutt regression (see LeSage
%           Econometric Toolbox)
% ------------------------------------------------------------
% INPUT: Y: Nx1 ---> vector of low frequency data
%        x: nxp ---> matrix of high frequency indicators (without intercept)
%        ta: type of disaggregation
%            ta=1 ---> sum (flow)
%            ta=2 ---> average (index)
%        sc: number of high frequency data points for each low frequency data points
%            sc= 3 ---> quarterly to monthly
%            sc= 4 ---> annual to quarterly
%        opC: 1x1 option related to intercept
%            opc = 0 : no intercept in hf model
%            opc = 1 : intercept in hf model
% ------------------------------------------------------------
% LIBRARY: aggreg, olsc
% ------------------------------------------------------------
% SEE ALSO: chowlin, litterman, fernandez, td_plot, td_print
% ------------------------------------------------------------
% REFERENCE: Chow, G. and Lin, A.L. (1971) "Best linear unbiased
% distribution and extrapolation of economic time series by related
% series", Review of Economic and Statistics, vol. 53, n. 4, p. 372-375.
% Bournay, J. y Laroque, G. (1979) "Reflexions sur la methode d'elaboration
% des comptes trimestriels", Annales de l'INSEE, n. 36, p. 3-30.

% written by:
%  Enrique M. Quilis
%  Macroeconomic Research Department
%  Ministry of Economy and Competitiveness
%  <enrique.quilis@mineco.es>

% Version 1.1 [August 2006]

t0=clock;

% ------------------------------------------------------------
% Checks

if ((sc ~= 3) & (sc ~= 4))
    error ('*** THE FREQUENCY CONVERSION SHOULD BE 3 OR 4 ***');
 end

if ((ta == 3) | (ta == 4))
    error ('*** THIS RELEASE DOES NOT PERFORM INTERPOLATION ***');
end

% ------------------------------------------------------------
% Size of the problem

[N,M] = size(Y);    % Size of low-frequency input
[n,p] = size(x);    % Size of p high-frequency inputs (without intercept)

% ------------------------------------------------------------
% Preparing the X matrix: including an intercept if opC==1

if (opC == 1)
   e=ones(n,1);
   x=[e x];       % Expanding the regressor matrix
   p=p+1;         % Number of p high-frequency inputs (plus intercept)
end

% ------------------------------------------------------------
% Generating the aggregation matrix

C = aggreg(ta,N,sc);

% -----------------------------------------------------------
% Expanding the aggregation matrix to perform
% extrapolation if needed.

if (n > sc * N)
   pred=n-sc*N;           % Number of required extrapolations
   C=[C zeros(N,pred)];
else
   pred=0;
end

% -----------------------------------------------------------
% Temporal aggregation of the indicators

X=C*x;

% ------------------------------------------------------------
% Computing annual rho by means of Cochrane-Orcutt

rex = olsc(Y,X); %Econometric Toolbox (LeSage, 1999)

Ra=rex.rho; %Getting annual rho

if (Ra < 0)
    error ('*** ANNUAL RHO IS NEGATIVE. END OF PROGRAM ***');
end

if (Ra >= 1)
   Ra = 0.99;
end

r = 0:0.01:0.99; nr = length(r); R=ones(nr,1);
switch sc
case 3 %Quarterly to monthly
   for i=1:nr
      R(i) = (r(i)^5+2*r(i)^4+3*r(i)^3+2*r(i)^2+r(i)) / (2*r(i)^2+4*r(i)+3);
   end
case 4 %Annual to quarterly
   % ------------------------------------------------------------
   % Evaluating the function that relates annual and quarterly rho
   for i=1:nr
      R(i) = (r(i)*(r(i)+1)*(r(i)^2+1)^2) / (2*(r(i)^2+r(i)+2));
   end
end

% -----------------------------------------------------------
% Determination of optimal rho

[aux,h] = min(abs(Ra-R));
rho = r(h);

% -----------------------------------------------------------
% Final estimation with optimal rho

I=eye(n); w=I;
LL = diag(-ones(n-1,1),-1);

Aux=I+rho*LL;
Aux(1,1)=sqrt(1-rho^2);
w=inv(Aux'*Aux);           % High frequency VCV matrix (without sigma_a)
W=C*w*C';                  % Low frequency VCV matrix (without sigma_a)
Wi=inv(W);
beta=(X'*Wi*X)\(X'*Wi*Y);  % beta estimator
U=Y-X*beta;                % Low frequency residuals
scp=U'*Wi*U;               % Weighted least squares
sigma_a=scp/(N-p);         % sigma_a estimator
L=w*C'*Wi;                 % Filtering matrix
u=L*U;                     % High frequency residuals

% -----------------------------------------------------------
% Temporally disaggregated time series

y = x*beta + u;

% -----------------------------------------------------------
% Information criteria
% Note: p is expanded to include the innovational parameter

aic=log(sigma_a)+2*(p+1)/N;
bic=log(sigma_a)+log(N)*(p+1)/N;

% -----------------------------------------------------------
% VCV matrix of high frequency estimates

sigma_beta=sigma_a*inv(X'*Wi*X);

VCV_y=sigma_a*(eye(n)-L*C)*w+(x-L*X)*sigma_beta*(x-L*X)';

d_y=sqrt((diag(VCV_y)));   % Std. dev. of high frequency estimates
y_li=y-d_y;           % Lower lim. of high frequency estimates
y_ls=y+d_y;           % Upper lim. of high frequency estimates

% -----------------------------------------------------------
% -----------------------------------------------------------
% Loading the structure

res.meth='Chow-Lin';

% -----------------------------------------------------------
% Basic parameters

res.ta        = ta;
res.N         = N;
res.n         = n;
res.pred      = pred;
res.sc        = sc;
res.p         = p;
res.type      = 3;  % For output convenience
res.opC       = opC;

% -----------------------------------------------------------
% Series

res.Y         = Y;
res.x         = x;
res.y         = y;
res.y_dt      = d_y;
res.y_lo      = y_li;
res.y_up      = y_ls;

% -----------------------------------------------------------
% Residuals

res.u         = u;
res.U         = U;

% -----------------------------------------------------------
% Parameters

res.beta      = beta;
res.beta_sd   = sqrt(diag(sigma_beta));
res.beta_t    = beta./sqrt(diag(sigma_beta));
res.rho       = rho;

% -----------------------------------------------------------
% Information criteria

res.aic       = aic;
res.bic       = bic;

% -----------------------------------------------------------
% Cochrane-Orcutt results

res.co       = rex;

% -----------------------------------------------------------
% Objective function

res.val       = R;
res.r         = r;
res.valA      = Ra * ones(nr,1);
res.ropt      = rho * ones(nr,1);

% -----------------------------------------------------------
% Elapsed time

res.et        = etime(clock,t0);


function plotData(X, y)
%PLOTDATA Plots the data points X and y into a new figure
%   PLOTDATA(x,y) plots the data points with + for the positive examples
%   and o for the negative examples. X is assumed to be a Mx2 matrix.

% Create New Figure
figure; hold on;

% ====================== YOUR CODE HERE ======================
% Instructions: Plot the positive and negative examples on a
%               2D plot, using the option 'k+' for the positive
%               examples and 'ko' for the negative examples.
%

% Find Indices of Positive and Negative Examples
pos = find(y==1); neg = find(y == 0);
% Plot Examples
plot(X(pos, 1), X(pos, 2), 'k+', 'LineWidth', 2, 'MarkerSize', 7);
plot(X(neg, 1), X(neg, 2), 'ko', 'MarkerFaceColor', 'y', 'MarkerSize', 7);

% =========================================================================

hold off;

end


function [z,Z,iZ,MD2,Z_e,Z_y] = innovation(y,R,e,E,f)

% INNOVATION  Innovation of an observation.
%   [z,Z] = INNOVATION(y,R,e,E) computes innovation z and innovation's
%   covariances matrix Z from a measurement N{y,R} to the expectation N{e,E}
%   as
%
%     z = y - e
%     Z = R + E
%
%   [z,Z] = INNOVATION(y,R,e,E,@Finn) uses the innovation function Finn to
%   compute the innovation:
%
%       z = Finn(y,e)
%
%   and uses its Jacobians F_e and F_y to compute Z:
%
%       Z = F_e*E*F_e' + F_y*R*F_y'
%
%   [z,Z,iZ,MD2] = INNOVATION(...) returns also the inverse of the
%   innovation covariance iZ and the squared Mahalanobis distance MD2.
%
%   [z,Z,iZ,MD2,F_e,F_y] INNOVATION(...) returns the Jacobians wrt the
%   expectation e and the measurement y.
%
%   EXAMPLES:
%   innovation(seg,SEG,hmLin,HMLIN,@hms2hh) is the innovation of a segment
%   measurement seg = [x1;y1;x2;y2] with respect to a homogeneous line
%   hmLin = [a;b;c], defined as the two orthogonal distances from [xi;yi]
%   to hmLin.
%
%   See also HMS2HH, MAHALANOBIS.

%   Copyright 2008-2009 Joan Sola @ LAAS-CNRS.

if nargin == 4  % Use plain Euclidean innovation
    z   = y - e;
    Z   = R + E;
    Z_e = -1;
    Z_y = 1;
else            % Use given function
    [z,Z_e,Z_y] = f(e,y);
    Z = Z_e*E*Z_e' + Z_y*R*Z_y';
end

% compute extra outputs
if nargout >= 3
    iZ = eye(size(Z,1))/Z;  % better than inv(Z) -- ask Matlab!
    if nargout >= 4
        MD2 = z'*iZ*z;
    end
end

% ========== End of function - Start GPL license ==========

%   # START GPL LICENSE

%---------------------------------------------------------------------
%
%   This file is part of SLAMTB, a SLAM toolbox for Matlab.
%
%   SLAMTB 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.
%
%   SLAMTB 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 SLAMTB.  If not, see <http://www.gnu.org/licenses/>.
%
%---------------------------------------------------------------------

%   SLAMTB is Copyright:
%   Copyright (c) 2008-2010, Joan Sola @ LAAS-CNRS,
%   Copyright (c) 2010-2013, Joan Sola,
%   Copyright (c) 2014-2015, Joan Sola @ IRI-UPC-CSIC,
%   SLAMTB is Copyright 2009
%   by Joan Sola, Teresa Vidal-Calleja, David Marquez and Jean Marie Codol
%   @ LAAS-CNRS.
%   See on top of this file for its particular copyright.

%   # END GPL LICENSE


% DeJong_f4.m
% De Jong's f4 function, ND, no noise
%
% described by Clerc in ...
% http://clerc.maurice.free.fr/pso/Semi-continuous_challenge/Semi-continuous_challenge.htm
%
% used to test optimization/global minimization problems
% in Clerc's "Semi-continuous challenge"
%
% f(x) = sum( [1:N].*(in.^4), 2)
%
% x = N element row vector containing [ x0, x1,..., xN ]
%   each row is processed independently,
%   you can feed in matrices of timeXN no prob
%
% example: cost = DeJong_f4([1,2;3,4;5,6])
% note minimum =0 @ x= all zeros

% Brian Birge
% Rev 1.0
% 9/12/04
function [out]=DeJong_f4(in)
 persistent D tlen d

% this speeds routine up a lot, if called from PSO these won't change from
% call to call (repmat is a cpu hog)
 Dx=length(in(1,:));
 tlenx=length(in(:,1));
 if isempty(D) | D~=Dx | tlen~=tlenx
   D=Dx; % dimension of prob
   tlen=tlenx; % how many separate states
   d=repmat([1:D],tlen,1); % needed to vectorize this
 end
 out = sum( d.*(in.^4), 2);


function [c,Ls] = unsdgtreal(f,g,a,M)
%UNSDGTREAL  Uniform non-stationary Discrete Gabor transform
%   Usage:  c=unsdgtreal(f,g,a,M);
%           [c,Ls]=unsdgtreal(f,g,a,M);
%
%   Input parameters:
%         f     : Input signal.
%         g     : Cell array of window functions.
%         a     : Vector of time positions of windows.
%         M     : Vector of numbers of frequency channels.
%   Output parameters:
%         c     : Cell array of coefficients.
%         Ls    : Length of input signal.
%
%   `unsdgtreal(f,g,a,M)` computes the non-stationary Gabor coefficients of the
%   input signal *f*. The signal *f* can be a multichannel signal, given in
%   the form of a 2D matrix of size $Ls \times W$, with *Ls* the signal
%   length and *W* the number of signal channels.
%
%   As opposed to |nsdgt| only the coefficients of the positive frequencies
%   of the output are returned. `unsdgtreal` will refuse to work for complex
%   valued input signals.
%
%   The non-stationary Gabor theory extends standard Gabor theory by
%   enabling the evolution of the window over time. It is therefore
%   necessary to specify a set of windows instead of a single window.  This
%   is done by using a cell array for *g*. In this cell array, the n'th
%   element `g{n}` is a row vector specifying the n'th window. The
%   uniformity means that the number of channels is not allowed to vary over
%   time.
%
%   The resulting coefficients is stored as a $M/2+1 \times N \times W$
%   array. `c(m,n,l)` is thus the value of the coefficient for time index *n*,
%   frequency index *m* and signal channel *l*.
%
%   The variable *a* contains the distance in samples between two
%   consecutive blocks of coefficients. The variable *M* contains the
%   number of channels for each block of coefficients. Both *a* and *M* are
%   vectors of integers.
%
%   The variables *g*, *a* and *M* must have the same length, and the result *c*
%   will also have the same length.
%
%   The time positions of the coefficients blocks can be obtained by the
%   following code. A value of 0 correspond to the first sample of the
%   signal::
%
%     timepos = cumsum(a)-a(1);
%
%   `[c,Ls]=unsdgtreal(f,g,a,M)` additionally returns the length *Ls* of the input
%   signal *f*. This is handy for reconstruction::
%
%     [c,Ls]=unsdgtreal(f,g,a,M);
%     fr=insdgtreal(c,gd,a,Ls);
%
%   will reconstruct the signal *f* no matter what the length of *f* is,
%   provided that *gd* are dual windows of *g*.
%
%   Notes:
%   ------
%
%   `unsdgtreal` uses circular border conditions, that is to say that the signal is
%   considered as periodic for windows overlapping the beginning or the
%   end of the signal.
%
%   The phaselocking convention used in `unsdgtreal` is different from the
%   convention used in the |dgt| function. `unsdgtreal` results are phaselocked (a
%   phase reference moving with the window is used), whereas |dgt| results are
%   not phaselocked (a fixed phase reference corresponding to time 0 of the
%   signal is used). See the help on |phaselock| for more details on
%   phaselocking conventions.
%
%   See also:  nsdgt, insdgtreal, nsgabdual, nsgabtight, phaselock
%
%   Demos:  demo_nsdgt
%
%   References: ltfatnote018

%   AUTHOR : Florent Jaillet
%   TESTING: TEST_NSDGTREAL
%   REFERENCE:

if ~isnumeric(a)
  error('%s: a must be numeric.',upper(mfilename));
end;

if ~isnumeric(M)
  error('%s: M must be numeric.',upper(mfilename));
end;

L=sum(a);

[f,Ls,W,wasrow,remembershape]=comp_sigreshape_pre(f,'UNSDGTREAL',0);
f=postpad(f,L);

[g,info]=nsgabwin(g,a,M);

if ~info.isuniform
    error('%s: M must be a scalar or a constant vector.',upper(mfilename));
end;
M=M(1);

timepos=cumsum(a)-a(1);

N=length(a); % Number of time positions

M2=floor(M/2)+1;
c=zeros(M2,N,W,assert_classname(f,g{1})); % Initialisation of the result

for ii=1:N
  shift=floor(length(g{ii})/2);
  temp=zeros(M,W,assert_classname(f,g{1}));

  % Windowing of the signal.
  % Possible improvements: The following could be computed faster by
  % explicitely computing the indexes instead of using modulo and the
  % repmat is not needed if the number of signal channels W=1 (but the time
  % difference when removing it whould be really small)
  temp(1:length(g{ii}))=f(mod((1:length(g{ii}))+timepos(ii)-shift-1,L)+1,:).*...
    repmat(conj(circshift(g{ii},shift)),1,W);

  temp=circshift(temp,-shift);
  if M<length(g{ii})
    % Fft size is smaller than window length, some aliasing is needed
    x=floor(length(g{ii})/M);
    y=length(g{ii})-x*M;
    % Possible improvements: the following could probably be computed
    % faster using matrix manipulation (reshape, sum...)
    temp1=temp;
    temp=zeros(M,size(temp,2),assert_classname(f,g{1}));
    for jj=0:x-1
      temp=temp+temp1(jj*M+(1:M),:);
    end
    temp(1:y,:)=temp(1:y,:)+temp1(x*M+(1:y),:);
  end

  % FFT of the windowed signal
  c(:,ii,:) = reshape(fftreal(temp),M2,1,W);
end


function value = csign2 ( z1, z2 )

%*****************************************************************************80
%
%% CSIGN2 is a complex transfer-of-sign function.
%
%  Discussion:
%
%    The L2 norm is used.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 April 2006
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Parameters:
%
%    Input, complex Z1, Z2, the arguments.
%
%    Output, complex VALUE,  a complex value, with the magnitude of
%    Z1, and the argument of Z2.
%
  if ( cabs2 ( z2 ) == 0.0 )
    value = 0.0;
  else
    value = cabs2 ( z1 ) * ( z2 / cabs2 ( z2 ) );
  end

  return
end


function hz=spc2hz(i,fs,n)
hz = i/((n-1)/(fs/2));


function [cmap] = buildcmap(colors)
% [cmap]=buildcmap(colors)
%
% This function can be used to build your own custom colormaps. Imagine if
% you want to display rainfall distribution map. You want a colormap which
% ideally brings rainfall in mind, which is not achiveved by colormaps such
% as winter, cool or jet and such. A gradient of white to blue will do the
% task, but you might also use a more complex gradient (such as
% white+blue+red or colors='wbr'). This function can be use to build any
% colormap using main colors rgbcmyk. In image processing, w (white) can be
% used as the first color so that in the output, the background (usually
% with 0 values) appears white. In the example of rainfall map, 'wb' will
% produce a rainfall density map where the background (if its DN values are
% 0) will appear as white.
%
% Inputs:
%  colors: string (char) of color codes, any sequence of rgbcmywk
%  representing different colors (such as 'b' for blue) is acceptable. If a
%  gradient of white to blue is needed, colors would be 'wb'; a rainbow of
%  white+blue+red+green would be 'wbrg'.
%
% Example:
%  [cmap]=buildcmap('wygbr');
% %try the output cmap:
% im=imread('cameraman.tif');
% imshow(im), colorbar
% colormap(cmap) %will use the output colormap
%
% First version: 14 Feb. 2013
% sohrabinia.m@gmail.com
%--------------------------------------------------------------------------

if nargin<1
    colors='wrgbcmyk';
end

if ~ischar(colors)
    error(['Error! colors must be a variable of type char with '...
        'color-names, such as ''r'', ''g'', etc., '...
        'type ''help buildcmap'' for more info']);
end

ncolors=length(colors)-1;

bins=round(255/ncolors);
% diff1=255-bins*ncolors;

vec=zeros(300,3);

switch colors(1)
    case 'w'
        vec(1,:)=1;
    case 'r'
        vec(1,:)=[1 0 0];
    case 'g'
        vec(1,:)=[0 1 0];
    case 'b'
        vec(1,:)=[0 0 1];
    case 'c'
        vec(1,:)=[0 1 1];
    case 'm'
        vec(1,:)=[1 0 1];
    case 'y'
        vec(1,:)=[1 1 0];
    case 'k'
        vec(1,:)=[0 0 0];
end

for i=1:ncolors
 beG=(i-1)*bins+1;
 enD=i*bins+1; %beG,enD
 switch colors(i+1)
     case 'w'
         vec(beG:enD,1)=linspace(vec(beG,1),1,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),1,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),1,bins+1)';%colors(i+1),beG,enD,
     case 'r'
         vec(beG:enD,1)=linspace(vec(beG,1),1,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),0,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),0,bins+1)';%colors(i+1),beG,enD
     case 'g'
         vec(beG:enD,1)=linspace(vec(beG,1),0,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),1,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),0,bins+1)';%colors(i+1),beG,enD
     case 'b'
         vec(beG:enD,1)=linspace(vec(beG,1),0,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),0,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),1,bins+1)';%colors(i+1),beG,enD
     case 'c'
         vec(beG:enD,1)=linspace(vec(beG,1),0,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),1,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),1,bins+1)';%colors(i+1),beG,enD
     case 'm'
         vec(beG:enD,1)=linspace(vec(beG,1),1,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),0,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),1,bins+1)';
     case 'y'
         vec(beG:enD,1)=linspace(vec(beG,1),1,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),1,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),0,bins+1)';
     case 'k'
         vec(beG:enD,1)=linspace(vec(beG,1),0,bins+1)';
         vec(beG:enD,2)=linspace(vec(beG,2),0,bins+1)';
         vec(beG:enD,3)=linspace(vec(beG,3),0,bins+1)';
 end
end
cmap=vec(1:bins*ncolors,:);
end %end of buildcmap


function [logww] = free_energy(vv,beta_k1,beta_k0,visbiases_base,visbiases,hidbias,vishid)

 [numcases,numdims] = size(vv);
 temp_base = vv*visbiases_base';
 temp_bias = vv*visbiases';
 tempvWh = hidbias + (vv*vishid);

 aa = beta_k1;
 p_star_k1  = (1-aa)*temp_base  + aa*temp_bias + sum(log(1+exp(aa*tempvWh)),2);

 aa = beta_k0;
 p_star_k0  =  (1-aa)*temp_base + aa*temp_bias + sum(log(1+exp(aa*tempvWh)),2);

 logww = (p_star_k1 - p_star_k0);


%This Matlab script can be used to reproduce Figure 3.8 in the monograph:
%
%Emil Bjornson, Jakob Hoydis and Luca Sanguinetti (2017),
%"Massive MIMO Networks: Spectral, Energy, and Hardware Efficiency",
%Foundations and Trends in Signal Processing: Vol. 11, No. 3-4,
%pp. 154-655. DOI: 10.1561/2000000093.
%
%For further information, visit: https://www.massivemimobook.com
%
%This is version 1.0 (Last edited: 2017-11-04)
%
%License: This code is licensed under the GPLv2 license. If you in any way
%use this code for research that results in publications, please cite our
%monograph as described above.

%Empty workspace and close figures
close all;
clear;

%Define number of UEs per cell
K = 10;

%Define the range of BS antennas
Mrange = 10:10:100;

%Define the pilot length
tau_p = K;

%Complexity of MMSE channel estimation, based on Table 3.1
complexity_MMSE = Mrange*tau_p + Mrange.^2;

%Complexity of EW-MMSE channel estimation, based on Table 3.1
complexity_EW_MMSE = Mrange*(tau_p + 1);

%Complexity of LS channel estimation, based on Table 3.1
complexity_LS = Mrange*tau_p;

%% Plot the simulation results
figure;
hold on; box on;

plot(Mrange,complexity_MMSE,'r--','LineWidth',1);
plot(Mrange,complexity_EW_MMSE,'k-','LineWidth',1);
plot(Mrange,complexity_LS,'b-.','LineWidth',1);

xlabel('Number of antennas (M)');
ylabel('Number of complex multiplications');
set(gca,'YScale','log');

legend('MMSE','EW-MMSE','LS','Location','NorthWest');


function element_node = grid_t10_element ( nelemx, nelemy )

%*****************************************************************************80
%
%% GRID_T10_ELEMENT produces a grid of pairs of 10 node triangles.
%
%  Example:
%
%    Input:
%
%      NELEMX = 2, NELEMY = 2
%
%    Output:
%
%      ELEMENT_NODE =
%         1,  2,  3,  4, 10, 16, 22, 15,  8,  9;
%        25, 24, 23, 22, 16, 10,  4, 11, 18, 17;
%         4,  5,  6,  7, 13, 19, 25, 18, 11, 12;
%        28, 27, 26, 25, 19, 13,  7, 14, 21, 20;
%        22, 23, 24, 25, 31, 37, 43, 36, 29, 30;
%        46, 45, 44, 43, 37, 31, 25, 32, 39, 38;
%        25, 26, 27, 28, 34, 40, 46, 39, 31, 33;
%        49, 48, 47, 46, 40, 34, 28, 35, 42, 41.
%
%  Grid:
%
%   43-44-45-46-47-48-49
%    |\     6 |\     8 |
%    | \      | \      |
%   36 37 38 39 40 41 42
%    |   \    |   \    |
%    |    \   |    \   |
%   29 30 31 32 33 34 35
%    |      \ |      \ |
%    | 5     \| 7     \|
%   22-23-24-25-26-27-28
%    |\     2 |\     4 |
%    | \      | \      |
%   15 16 17 18 19 20 21
%    |   \    |   \    |
%    |    \   |    \   |
%    8  9 10 11 12 13 14
%    |      \ |      \ |
%    | 1     \| 3     \|
%    1--2--3--4--5--6--7
%
%  Reference Element T10:
%
%    |
%    1  10
%    |  |\
%    |  | \
%    |  8  9
%    |  |   \
%    S  |    \
%    |  5  6  7
%    |  |      \
%    |  |       \
%    0  1--2--3--4
%    |
%    +--0----R---1-->
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 April 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NELEMX, NELEMY, the number of elements along the
%    X and Y directions.  The number of elements generated will be
%    2 * NELEMX * NELEMY.
%
%    Output, integer ELEMENT_NODE(10,2*NELEMX*NELEMY), the nodes that form
%    each element.
%
  element = 0;

  for j = 1 : nelemy
    for i = 1 : nelemx

      base = ( j - 1 ) * 3 * ( 3 * nelemx + 1 ) + 3 * i - 2;

      element = element + 1;

      element_node( 1,element) = base;
      element_node( 2,element) = base                          + 1;
      element_node( 3,element) = base                          + 2;
      element_node( 4,element) = base                          + 3;
      element_node( 5,element) = base +     ( 3 * nelemx + 1 ) + 2;
      element_node( 6,element) = base + 2 * ( 3 * nelemx + 1 ) + 1;
      element_node( 7,element) = base + 3 * ( 3 * nelemx + 1 );
      element_node( 8,element) = base + 2 * ( 3 * nelemx + 1 );
      element_node( 9,element) = base +     ( 2 * nelemx + 1 ) + 2;
      element_node(10,element) = base +     ( 2 * nelemx + 1 ) + 3;

      element = element + 1;

      element_node( 1,element) = base + 3 * ( 3 * nelemx + 1 ) + 3;
      element_node( 2,element) = base + 3 * ( 3 * nelemx + 1 ) + 2;
      element_node( 3,element) = base + 3 * ( 3 * nelemx + 1 ) + 1;
      element_node( 4,element) = base + 3 * ( 3 * nelemx + 1 );
      element_node( 5,element) = base + 2 * ( 3 * nelemx + 1 ) + 1;
      element_node( 6,element) = base +     ( 3 * nelemx + 1 ) + 2;
      element_node( 7,element) = base                          + 3;
      element_node( 8,element) = base +     ( 3 * nelemx + 1 ) + 3;
      element_node( 9,element) = base + 2 * ( 3 * nelemx + 1 ) + 3;
      element_node(10,element) = base + 2 * ( 3 * nelemx + 1 ) + 2;

    end
  end

  return
end


function [on,rt,ac] = spm_ADEM_cue_rt(DEM)
% returns reaction times and accuracy for ADEM_cued_response demo
% FORMAT [on,rt,ac] = spm_ADEM_cue_rt(DEM)
%
% DEM - DEM structure from ADEM_cued_response.m
%
% on  - cue onset
% ac  - accuracy
% rt  - reaction time
%__________________________________________________________________________
% Copyright (C) 2008 Wellcome Trust Centre for Neuroimaging

% Karl Friston
% $Id: spm_ADEM_set_rt.m 4231 2011-03-07 21:00:02Z karl $

% distance from target and cue contrast
%--------------------------------------------------------------------------
P   = DEM.pP.P{1};                            % location of targets
L   = DEM.pU.v{1}((1:2) + 2,:);               % location of finger
n   = length(P);                              % number of targets
N   = length(L);                              % number of time bins
D   = sparse(n,N);
for j = 1:N
    for i = 1:n
        D(i,j) = D(i,j) + sum((L(:,j) - P(:,i)).^2);
    end
end
D   = sqrt(D);                                % distance from targets
C   = DEM.pU.v{1}((1:n) + 4,:);               % contrast of targets

r   = 1/32;                                   % radius of proximity
c   = diff(C > 1/2,1,2) > 0;                  % target onset
on  = {};                                     % cue onset
ac  = {};                                     % accuracy
rt  = {};                                     % reaction time

% get performance
%--------------------------------------------------------------------------
for i = 1:n

    on{i} = find(c(i,:));
    for j = 1:length(on{i})
        try

            % minimum distance
            %--------------------------------------------------------------
            d        = D(i,(1:8) + on{i}(j))';
            ac{i}(j) = sqrt(min(d));

            % estimated reaction time
            %--------------------------------------------------------------
            X        = (1:length(d))' - 1;
            B        = pinv([X.^0 X.^1])*log(d);
            rt{i}(j) = (log(r) - B(1))/B(2);

        catch
            ac{i}(j) = NaN;
            rt{i}(j) = NaN;
        end
    end
end

% sort trials (over all targets
%--------------------------------------------------------------------------
on = spm_vec(on); [i j] = sort(on,1,'ascend'); on = on(j);
ac = spm_vec(ac); ac = ac(j);
rt = spm_vec(rt); rt = rt(j);

% remove first trial
%--------------------------------------------------------------------------
on(1) = [];
rt(1) = [];
ac(1) = [];

% convert spatial error to accuracy
%--------------------------------------------------------------------------
ac    = 1./ac;

% convert reaction time to ms
%--------------------------------------------------------------------------
dt    = 64/1000;
rt    = rt*1000*dt;
on    = on*dt;


% Shared Matting Matte Refinement
% This function implements the matte refinement approach described in
% Eduardo S. L. Gastal, Manuel M. Oliveira, "Shared Sampling for
% Real-Time Alpha Matting", Computer Graphics Forum, 2010.
% 'alphaHat' and 'confidences' parameters are typically obtained by a
% sampling-based natural matting algorithm. 'confidences' is filled by
% ones if not provided. Optional input parameter 'params' can be
% customized by editing the default values in the struct returned
% by 'getMattingParams('SharedMatting').
% - loc_*** define the parameters for the matting Laplacian.
% - refinement_mult determines how much trust is given to the initial
%   alpha estimation

function alpha = sharedMattingMatteRefinement(image, trimap, alphaHat, confidences, params, suppressMessages)
    abmtSetup
    tic;
    if ~exist('confidences', 'var') || isempty(confidences)
        confidences = ones(size(alphaHat(:,:,1)));
    end
    if ~exist('params', 'var') || isempty(params)
        params = getMattingParams('SharedMatting');
    end
    if ~exist('suppressMessages', 'var') || isempty(suppressMessages)
        suppressMessages = false;
    end
    if(~suppressMessages) display('Matte refinement via Shared Matting...'); end

    image = im2double(image);
    trimap = im2double(trimap(:,:,1));
    alphaHat = im2double(alphaHat(:,:,1));

    % Compute matting Laplacian
    unk = trimap < 0.8 & trimap > 0.2;
    dilUnk = imdilate(unk, ones(3, 3));
    if(~suppressMessages) display('     Computing matting Laplacian...'); end
    Lap = affinityMatrixToLaplacian(mattingAffinity(image, dilUnk, params.loc_win, params.loc_eps));

    if(~suppressMessages) display('     Solving for alphas...'); end
    alpha = solveForAlphas(Lap, trimap, params.lambda, params.usePCGtoSolve, alphaHat, confidences, params.refinement_mult);

    alpha = reshape(alpha, [size(image, 1), size(image, 2)]);

    dur = toc;
    if(~suppressMessages) display(['Done. It took ' num2str(dur) ' seconds.']); end
end


function [y, b] = remove_baseline(y, sn)
% estiamte baseline of the calcium traces and subtract it
if ~exist('sn', 'var') || isempty(sn)
    sn = get_noise_fft(reshape(y, 1, []));
end
sz = size(y);
y = reshape(y, 1, []);
y_diff = [-1, diff(y)];
b = median(y(and(y_diff>=0, y_diff<sn)));
y = reshape(y-b, sz);


% Test file for SPINSPHERE:

function pass = test_spinsphere()

tol = 1e-2;

%% AC:

% Solve with DT and DT/2:
S = spinopsphere('AC'); S.tspan = S.tspan/10;
N = 128; dt = 1e-1;
u = spinsphere(S, N, dt, 'plot', 'off');
v = spinsphere(S, N, dt/2, 'plot', 'off');

% Compare:
dom = S.domain;
[xx, yy] = meshgrid(linspace(dom(1), dom(2), 50));
scale = max(max(abs(v(xx,yy))));
pass(1) = max(max(abs(u(xx,yy) - v(xx,yy))))/scale < tol;

%% GL:

% Solve with DT and DT/2:
S = spinopsphere('GL'); S.tspan = S.tspan/10;
S.init =  spherefun(@(x,y,z) cos(cosh(x.*z)-y));
N = 128; dt = 1e-1;
u = spinsphere(S, N, dt, 'plot', 'off');
v = spinsphere(S, N, dt/2, 'plot', 'off');

% Compare:
dom = S.domain;
[xx, yy] = meshgrid(linspace(dom(1), dom(2), 50));
scale = max(max(abs(v(xx,yy))));
pass(2) = max(max(abs(u(xx,yy) - v(xx,yy))))/scale < tol;

end


function [datsmooth] = ft_preproc_smooth(dat, n, tol)

% FT_PREPROC_SMOOTH performs boxcar smoothing with specified length.
% Edge behavior is improved by implicit padding with the mean over
% half the boxcar length at the edges of the data segment.
%
% Use as
%   [dat] = ft_preproc_smooth(dat, n)
%
% Where dat is an Nchan x Ntime data matrix, and n is the length
% of the boxcar smoothing kernel
%
% If the data contains NaNs, these are ignored for the computation, but
% retained in the output.
%
% See also PREPROC

% Undocumented options:
%  n can also be a vector containing a custom smoothing kernel
%  n can also be 'regsmooth', using a regularised estimate of the first temporal derivative
%
% Copyright (C) 2010, Stefan Klanke
%
% This file is part of FieldTrip, see http://www.fieldtriptoolbox.org
% for the documentation and details.
%
%    FieldTrip 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.
%
%    FieldTrip 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 FieldTrip. If not, see <http://www.gnu.org/licenses/>.
%
% $Id$

% preprocessing fails on channels that contain NaN
if any(isnan(dat(:)))
  ft_warning('FieldTrip:dataContainsNaN', 'data contains NaN values');
end

% create smoothing kernel
regflag = false;
if isequal(n, 'regsmooth')
  regflag = true;
  n = 0;
elseif isscalar(n)
  krn = ones(1,n)/n;
else
  krn = n(:)'./sum(n(:));
  n   = numel(krn);
end

% deal with padding
dat = ft_preproc_padding(dat, 'localmean', ceil(n/2));

% do the smoothing
if regflag
  if nargin<3
    tol = 1e-9;
  end
  datsmooth = smooth_regularised(dat, tol);
elseif n<100
  % heuristic: for large kernel the convolution is faster when done along
  % the columns, weighing against the costs of doing the transposition.
  % the threshold of 100 is a bit ad hoc.
  datsmooth = convn(dat,   krn,   'same');
else
  datsmooth = convn(dat.', krn.', 'same').';
end

% cut the eges
datsmooth = ft_preproc_padding(datsmooth, 'remove', ceil(n/2));

function out = smooth_regularised(dat, tol)

tol = tol.*std(dat(:));
n   = size(dat, 2);
B    = eye(n);

% create Toeplitz matrix F
r = [1 zeros(1,n-1)];
d = [1 zeros(1,n-1)];
m = 2;
for k=1:m
 d = filter([1 -1],1,d);
end
F = toeplitz(d,r);

% create Toeplitz matrix G
c = ones(n,1);
G = toeplitz(c,r);

% compute gamma parameter

% SVD
H       = B*(G/F);
[U,D,V] = svd(H);
diagD2  = diag(D).^2;
diagD   = diag(D);
epsi    = U'*B*dat.';

gammarange = 10.^(-10:0.2:10);
ngamma     = numel(gammarange);
onevec_n   = ones(n,1);
onevec_ngamma = ones(1,ngamma);

nchan = size(dat,1);
ro    = zeros(n,ngamma,nchan);
for k = 1:nchan
  ro(:,:,k) = (gammarange(onevec_n,:).*epsi(:,k.*onevec_ngamma))./(diagD2(:,onevec_ngamma) + gammarange(onevec_n,:));
end
wrss = squeeze(sum(ro.^2));

gamma = zeros(nchan,1);
ni = zeros(n,nchan);
for k = 1:nchan
  gamma(k,1) = gammarange(find(wrss(:,k)<tol,1,'last'));
  ni(:,k) = (diagD.*epsi(:,k))./(diagD2 + gamma(k));
end

ddata_smooth = transpose(F\V*ni);
out          = ddata_smooth*G';


classdef DTLZ7 < PROBLEM
% <multi/many> <real> <large/none> <expensive/none>
% Benchmark MOP proposed by Deb, Thiele, Laumanns, and Zitzler

%------------------------------- Reference --------------------------------
% K. Deb, L. Thiele, M. Laumanns, and E. Zitzler, Scalable test problems
% for evolutionary multiobjective optimization, Evolutionary multiobjective
% Optimization. Theoretical Advances and Applications, 2005, 105-145.
%------------------------------- Copyright --------------------------------
% Copyright (c) 2023 BIMK Group. You are free to use the PlatEMO for
% research purposes. All publications which use this platform or any code
% in the platform should acknowledge the use of "PlatEMO" and reference "Ye
% Tian, Ran Cheng, Xingyi Zhang, and Yaochu Jin, PlatEMO: A MATLAB platform
% for evolutionary multi-objective optimization [educational forum], IEEE
% Computational Intelligence Magazine, 2017, 12(4): 73-87".
%--------------------------------------------------------------------------

    methods
        %% Default settings of the problem
        function Setting(obj)
            if isempty(obj.M); obj.M = 3; end
            if isempty(obj.D); obj.D = obj.M+19; end
            obj.lower    = zeros(1,obj.D);
            obj.upper    = ones(1,obj.D);
            obj.encoding = ones(1,obj.D);
        end
        %% Calculate objective values
        function PopObj = CalObj(obj,PopDec)
            PopObj = zeros(size(PopDec,1),obj.M);
            g      = 1+9*mean(PopDec(:,obj.M:end),2);
            PopObj(:,1:obj.M-1) = PopDec(:,1:obj.M-1);
            PopObj(:,obj.M)     = (1+g).*(obj.M-sum(PopObj(:,1:obj.M-1)./(1+repmat(g,1,obj.M-1)).*(1+sin(3*pi.*PopObj(:,1:obj.M-1))),2));
        end
        %% Generate points on the Pareto front
        function R = GetOptimum(obj,N)
            interval     = [0,0.251412,0.631627,0.859401];
            median       = (interval(2)-interval(1))/(interval(4)-interval(3)+interval(2)-interval(1));
            X            = UniformPoint(N,obj.M-1,'grid');
            X(X<=median) = X(X<=median)*(interval(2)-interval(1))/median+interval(1);
            X(X>median)  = (X(X>median)-median)*(interval(4)-interval(3))/(1-median)+interval(3);
            R            = [X,2*(obj.M-sum(X/2.*(1+sin(3*pi.*X)),2))];
        end
        %% Generate the image of Pareto front
        function R = GetPF(obj)
            if obj.M == 2
                x      = linspace(0,1,100)';
                y      = 2*(2-x/2.*(1+sin(3*pi*x)));
                nd     = NDSort([x,y],1)==1;
                x(~nd) = nan;
                R      = [x,y];
            elseif obj.M == 3
                [x,y]  = meshgrid(linspace(0,1,20));
                z      = 2*(3-x/2.*(1+sin(3*pi*x))-y/2.*(1+sin(3*pi*y)));
                nd     = reshape(NDSort([x(:),y(:),z(:)],1)==1,size(z));
                z(~nd) = nan;
                R      = {x,y,z};
            else
                R = [];
            end
        end
    end
end


function [result_edgesize,result_pertg,nvell_num] = Riverflux_distribution(obj)
% [result_edgesize,result_pertg，nvell_num] = Riverflux_distribution(obj)
%
% Input a msh class object to get the representative edge width and flux
% percentage for each node on the riverine flow boundary.
%
% This function is used to distribute a total flux of a cross-section where
% the riverine boundary located to each node of the riverine boundary.
%
% result_edgesize and result_pertgis are the result of the representative
% edge width and flux percentage for each node, respectively. nvell_num
% represents the number of nodes for each riverine boundary.
%
% Each column of result_edgesize and result_pertg represents the result of
% each riverine boundary.
%
% Nodal representative edge width equals to the sum of half the width of
% each of the two edges it is connected to.
%
% Nodeal flow percentage on the riverine boundary equals to the flow area
% of this node divided by the total flow area of the cross-section.
%
% Nodal flow area is calculated via a trapezoidal rule using its representative
% edge width and the bathymetric depths of this node and its neighboring nodes.
%
% Note that the calculation of representative edge width and flow percentage
% for the nodes at either end of the boundary is a little bit of different.
%
% User need to specify river flow boundaries (ibtype=22) before using it.
%
% Author:      Jiangchao Qiu
% Created:     January 7 2021
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
bd_dat = obj.bd;
p_dat = obj.p;
b_dat = obj.b;
river_num = find(bd_dat.ibtype == 22);
N = length(river_num);% total number of river boundarys
nvell_num = bd_dat.nvell(river_num);% number of nodes for each river boundary

% Consider the riverine boundaries may have different number of nodes, the
% number of rows for result_edgesize and result_pertg is set to max(nvell_num)
result_edgesize = NaN(max(nvell_num),N); % the final result of edgesize
result_pertg = NaN(max(nvell_num),N);% the final result of percentage

if isempty(river_num)
    error('No riverine boundary information to distribute total flow')
end

for i=1:N
    node_num = bd_dat.nbvv(:,river_num(i));
    node_num(node_num==0)=[];
    bathy = b_dat(node_num);
    location = p_dat(node_num,:);
    J = length(node_num);% total number of nodes for the current river boundary
    flowarea = zeros(J,1);
    edgesize = zeros(J,1);
    %% calculate the projected distance for each edge on the boundary
    proj = 'Mercator';
    m_proj(proj,'lon',[ min(obj.p(:,1))-0.25 max(obj.p(:,1))+0.25 ],...
                'lat',[ min(obj.p(:,2))-0.25 max(obj.p(:,2))+0.25])
    proj_location = zeros(J,2);
    for j=1:J
        [proj_location(j,1),proj_location(j,2)] = m_ll2xy(location(j,1),location(j,2));
    end
    node_distance = 1000*m_xydist(proj_location(:,1),proj_location(:,2));
    %% calculate the respresentive width for each node
    % note: if the current boundary has J nodes, there are J-1 edges
    for j=1:J
		if j==1      % the first edge (the number is J)
            edgesize(j) = 0.5*node_distance(j);
        elseif j==J  % the last edge (the number is J-1)
            edgesize(j) = 0.5*node_distance(j-1);
        else         % the other edges
            edgesize(j) = 0.5*node_distance(j-1)+0.5*node_distance(j);
        end
        result_edgesize(1:J,i) = edgesize;
    end
    %% calculate flow area for each node on the boundary
    for j=1:J
        if j==1      % the first node
            local_z1 = (bathy(j)+bathy(j+1))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j));
        elseif j==J  % the last node
            local_z1 = (bathy(j-1)+bathy(j))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j-1));
        else         % the other nodes
            local_z1 = (bathy(j-1)+bathy(j))*0.5;
            local_z2 = (bathy(j)+bathy(j+1))*0.5;
            flowarea(j) = 0.5*(bathy(j)+local_z1)*(0.5*node_distance(j-1))+...
                          0.5*(bathy(j)+local_z2)*(0.5*node_distance(j));
        end
        percent = flowarea/sum(flowarea);  % the flux distribution percentage for each node
        result_pertg(1:J,i) =  percent;
    end
end


function pass = test_complex(pref)
% Test complex

if ( nargin == 0)
    pref = chebfunpref;
end
tol = 1000*pref.cheb3Prefs.chebfun3eps;

f = chebfun3(@(x,y,z) sin(x.*y.*z));
g = chebfun3(@(x,y,z) cos(x.*y.*z));
h = chebfun3(@(x,y,z) sin(x.*y.*z) + 1i*cos(x.*y.*z));
pass = norm(h - complex(f, g)) < tol;

end


function  [Ypred, ps] = evaluateHist(model, X)

grids = model.grids;
ntypes = size(model.hist,3);

logps = zeros(size(X,1), ntypes);
for j = 1:size(model.grids,2)
    xp = X(:, j+1);
    xp(xp<grids(1,j))   = grids(1,j);
    xp(xp>grids(end,j)) = grids(end,j);

    [~, ~, ibin]    = histcounts(xp, grids(:,j));

    logps           = logps + log(sq(model.hist(ibin, j, :)));
end

ps = ones(1,ntypes)/ntypes;
for j = 1:10
    L    = bsxfun(@plus, logps, log(ps));
    L    = bsxfun(@minus, L, max(L, [], 2));
    rs   = exp(L) + 1e-5;
    rs   = bsxfun(@rdivide, rs, sum(rs,2));
    ps   = mean(rs,1);
end

Ypred = rs(:,1);


function [betas,stats] = weighted_glmfit(Y,varargin)
% Calculate weighted average using weighted linear least squares
% See examples below for usage
%
% Model:
% Y_i = 1*Ypop + noise
%
% :Inputs:
%
%   **Y:**
%        data matrix (nsub x T)
%
%   **w:**
%        weights
%
%   **varY:**
%        variance of data at each time point (nsub x T) + var between
%
% :Outputs:
%
%   **Ymean:**
%        weighted mean of each column of Y
%
%   **dfe:**
%        error degrees of freedom, adjusted for inequality of variance
%        (Sattherwaite) and pooled across data columns
%
% :Extended output in stats structure:
%
%   **stats.t:**
%        t-values for weighted t-test
%
%   **stats.p:**
%        2-tailed p-values for weighted t-test
%
%   **r:**
%        weighted correlation coeff across columns of Y
%
%   **xy:**
%        weighted covariance matrix
%
%   **v:**
%        weighted variance estimates for each column of Y
%          - sqrt(v) is the standard error of the mean (or grp difference)
%
%
%   **stats.fits:**
%        fits  for each group (Ymean by group), low contrast weight group then high
%
% Fastest if no stats are asked for.
%
% :Computation time:
% For FULL stats report
%   - Triples from 500 -> 1000 columns of Y, continues to increase
%
% For mean/dfe only, fast for full dataset (many columns of Y)
%
% :Examples:
%
% Basic multivariate stats for 1000 columns of dat, no weighting
% Multivariate covariances are meaningful if cols of Y are organized, e.g.,
% timeseries
% ::
%
%    [means,stats] = weighted_glmfit(dat(:,1:1000));
%
% The same, but return univariate stats only (good for large Y)
% ::
%
%    [means,stats] = weighted_glmfit(dat,'uni');
%
% A weighted version, where we put in the weights, and with a design matrix too:
% ::
%
%    [means,stats] = weighted_glmfit(X,dat,'uni','w',weights);
%
% A weighted version, where weights are determined from w/i subject variances:
% ::
%
%    [means,stats] = weighted_glmfit(X,dat,'uni','vary',variances);
%
% ..
%    NOTE: TOR CHANGED INPUT TO ASSUME THAT WE SHOULD ENTER VARWI + VARBETWEEN
% ..

if nargin == 0, error('Must at least enter data as 1st argument.'); end

% --------------------------------------
% * Set up arguments
% --------------------------------------

domultivariate = 0;     % multivariate covariance est for Y

zpdiff = []; w = []; varY = []; X = [];

for i = 1:length(varargin)
    arg = varargin{i};
    if ischar(arg)
        switch lower(arg)
            case 'w', w = varargin{i+1};
            case 'vary', varY = varargin{i+1};
            case 'uni', domultivariate = 0;
            case 'multi', domultivariate = 1;

            case {'X','x'}, X = varargin{i+1};
        end
    end
end

% fill in missing inputs with default values

if ~is_entered(w), w = ones(m,1);  end
if ~is_entered(varY), varY = ones(m,1); end
if ~is_entered(X), X = ones(m,1);  end

% Get rid of missing values
nancols = find(any(isnan(Y) | Y==0,1));
Y(:,nancols) = [];

[m,n] = size(Y);

% --------------------------------------
% * Means and contrast
% --------------------------------------

% pool weights across all voxels
[betas,invxwx,bform,fits] = get_betas_singleweight(X,Y,w);

if nargout == 1, return, end

% --------------------------------------
% * Residuals
% --------------------------------------

e = Y - fits;         % residuals

% --------------------------------------
% * Degrees of freedom
% --------------------------------------

[dfe,dfediff] = get_dfe(m,n,X,bform,varY,0);

if ~domultivariate
    % ======================================
    %
    %
    % Univariate stats: MSE, t, and p-values
    %
    %
    % ======================================

    % --------------------------------------
    % * Mean squared error
    % --------------------------------------

    W = diag(w);                    % Weight matrix
    % Loop version of MSE: avoids out of memory errors for large voxel sets
    MSE = zeros(1,n); for i=1:n, MSE(i) = e(:,i)'*W*e(:,i); end, MSE = MSE/dfe;

    k = size(betas,1);
    v = repmat(diag(invxwx),1,n) .* repmat(MSE,k,1);
    %v = invxwx * MSE;       % variances for mean

    % output
    stats.descrip1 = 'Univariate stats for test against zero:';
    stats.v = v;
    stats.v_descrip = 'V = ste^2; variance of mean estimate';
    stats.t = betas ./ sqrt(v);
    stats.p = 2 * ( 1 - tcdf(abs(stats.t),dfe) );
    stats.dfe = dfe;

else
    % ======================================
    %
    %
    % Multivariate stats: MSE, cov(Y), r(Y)
    % Useful for simulating t-values under dependence
    %
    % ======================================

    % --------------------------------------
    % * Mean squared error
    % --------------------------------------

    % additional output: covariance matrix for betas and zdiff across time
    % (columns)
    % and correlation matrix for betas and zdiff
    % used in Monte Carlo simulations for controlling false positives
    % across columns

    MSE = (e'*W*e)/dfe;             % Mean square error

    if dobtwn
        MSEdiff = (ediff'*W*ediff)/dfediff;
    end

    % --------------------------------------
    % * Estimated covariance and correlation
    %   Estimated between-subjects variance (v)
    % --------------------------------------

    xy = invxwx * MSE;           % Covariance matrix for betas;

    xy = 0.5*(xy+xy');              % Remove rounding error

    if dobtwn
        xydiff = inv(bcon'*W*bcon)*MSEdiff;           % Covariance matrix for betas;
        xydiff = 0.5*(xydiff+xydiff');
    end

    v = diag(xy);                   % Variance for betas

    if dobtwn
        vdiff = diag(xydiff);
    end

    r = xy./sqrt(v*v');             % Correlation matrix for betas

    if dobtwn
        rdiff = xydiff./sqrt(vdiff*vdiff');         % Correlation matrix for betas
    end

    stats.descrip1 = 'Multivariate stats for test against zero:';
    stats.r = r;
    stats.v = v;
    stats.xy = xy;

    stats.t = betas ./ sqrt(v');
    stats.p = 2 * ( 1 - tcdf(abs(stats.t),dfe) );

end

return

function [dfe,dfediff] = get_dfe(m,n,X,bform,varY,dobtwn,hatdiff,bcon)

dfediff = [];

% Set up residual-forming matrix
% --------------------------------------
dfe_v = zeros(n,1);
R = eye(m) - X*bform;    % residual inducing matrix

% contrast, if entered
if dobtwn
    dfe_vdiff = zeros(n,1);
    Rdiff = eye(m) - bcon * hatdiff;
end

% Calculate effective degrees of freedom
% --------------------------------------

have_unique_vars = size(varY,2) == n;

if ~have_unique_vars

    % Only one (pooled?) vector of variance estimates
    % --------------------------------------
    V = diag(varY(:,1));
    dfe = (trace(R*V)^2)/trace(R*V*R*V);       % Satherwaite approximation
    if dobtwn, dfediff = (trace(Rdiff*V)^2)/trace(Rdiff*V*Rdiff*V); end
else
    % Variance estimates for each data vector
    % --------------------------------------
    for i=1:n,

        % make diagonal matrix of variances
        V = diag(varY(:,i));

        dfe_v(i) = (trace(R*V)^2)/trace(R*V*R*V);       % Satherwaite approximation

        if dobtwn
            dfe_vdiff(i) = (trace(Rdiff*V)^2)/trace(Rdiff*V*Rdiff*V);
        end

    end

    dfe = mean(dfe_v);               % Calculate average df over all columns (pool over data vectors)
    if dobtwn
        dfediff = mean(dfe_vdiff);
    end

end

return

function bool = is_entered(x)

bool = exist('x','var') && ~isempty(x);

return

%
%
% Duplicated in robust_reg_pooled
%
%

function [betas,invxwx,bform,fits] = get_betas_singleweight(X,Y,w)

W = diag(w);                    % Weight matrix

%X = repmat(1,m,1);              % Design matrix - 1 column of all ones to calculate average
% and, separately, use bcon if that's entered

invxwx = inv(X'*W*X);
bform = invxwx * X'* W;         % beta-forming matrix.  hat = X * bform

% rows are columns of design (X), cols are Y variables
betas = bform*Y;

if nargout > 3
    fits = X * betas;
end

return

function w = bisquare_weight(r,radjust,xrank)
% r is residuals
% radjust is adjustment factor: DuMouchel & O'Brien
% xrank is rank of weighted X matrix (design)
% w is weights from bisquare function
% n is number of Y variables to replicate weights over
tuneconst = 4.685;

r = r .* radjust;
s = mad_sigma_pooled(r,xrank);
r = r ./ (s*tuneconst);
w = (abs(r)<1) .* (1 - r.^2).^2;
return

function s = mad_sigma_pooled(r,xrank)
%    Compute std estimate using MAD of residuals from 0
rsort = sort(abs(r));
rsort = rsort(xrank:end,:); % eliminate smallest; like reducing df
s = median(rsort(:)) / 0.6745;
return

function str = display_string(str)
str = sprintf(str); fprintf(1,'%s',str);
return

function erase_string(str)

len = length(str);
str2 = repmat('\b',1,len);

fprintf(1,str2);

return


function [RNew, phi, psi, alphaNew, gammaOld, gammaNew] = ...
        computeGammaMultipleSinus(...
        ROld, iOrder, crossCorrelationVectors, a, phi, psi, gammaOld, ...
        gammaNew, alphaOld, hankelMatrixIsAdded, dcIsIncluded)

    nPitches = length(a);
    RNew = computeRowsOfToeplitzHankelMatrix(iOrder, iOrder, ...
        crossCorrelationVectors, hankelMatrixIsAdded, dcIsIncluded);
    lambda = a-sum(ROld.*phi,1);
    mu = -sum(ROld.*psi,1);
    phi = [phi;zeros(1,nPitches)]+(ones(iOrder-1,1)*lambda).*gammaNew;
    psi = [psi;zeros(1,nPitches)]+(ones(iOrder-1,1)*mu).*gammaNew;
    alphaNew = sum(RNew(1:end-1,:).*gammaNew,1);
    b = (ones(iOrder-1,1)*(alphaOld-alphaNew)).*gammaNew+...
        [zeros(1,nPitches);gammaNew(1:iOrder-2,:)]+...
        [gammaNew(2:end,:);zeros(1,nPitches)]-...
        [gammaOld(1:iOrder-2,:);zeros(1,nPitches)]+...
        (ones(iOrder-1,1)*psi(end,:)).*phi-...
        (ones(iOrder-1,1)*phi(end,:)).*psi;
    nu = sum(RNew(1:end-1,:).*b)./gammaNew(end,:);
    gammaOld = gammaNew;
    gammaNew = nan(iOrder,nPitches);
    gammaNew(iOrder,:) = 1./(nu+RNew(iOrder,:));
    gammaNew(1:iOrder-1,:) = (ones(iOrder-1,1)*...
        (gammaNew(iOrder,:)./gammaOld(end,:))).*b;

end


function varargout = spm_diffeo(varargin)
% Mex function called for image registration stuff
%
%_______________________________________________________________________
%
% FORMAT u = spm_diffeo('vel2mom', v, param)
% v     - velocity (flow) field n1*n2*n3*3.
% param - 8 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation parameters
%           - [4] Absolute displacements need to be penalised by a tiny
%                 amount.  The first element encodes the amount of
%                 penalty on these.  Ideally, absolute displacements
%                 should not be penalised, but it is usually necessary
%                 for technical reasons.
%           - [5] The `membrane energy' of the deformation is penalised,
%                 usually by a relatively small amount. This penalises
%                 the sum of squares of the derivatives of the velocity
%                 field (ie the sum of squares of the elements of the
%                 Jacobian tensors).
%           - [6] The `bending energy' is penalised (3rd element). This
%                 penalises the sum of squares of the 2nd derivatives of
%                 the velocity.
%           - [7][8] Linear elasticity regularisation is also included.
%                    The first parameter (mu) is similar to that for
%                    linear elasticity, except it penalises the sum of
%                    squares of the Jacobian tensors after they have been
%                    made symmetric (by averaging with the transpose).
%                    This term essentially penalises length changes,
%                    without penalising rotations.
%                    The final term also relates to linear elasticity,
%                    and is the weight that denotes how much to penalise
%                    changes to the divergence of the velocities (lambda).
%                    This divergence is a measure of the rate of volumetric
%                    expansion or contraction.
% u       - `momentum' field n1*n2*n3*3.
%
% Convert a velocity field to a momentum field by u = A*v, where
% A is the large sparse matrix encoding some form of regularisation.
% v and m are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('mom2vel',g, param)
% v     - the solution n1*n2*n3*3
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Number of Full Multigrid cycles.
%         - [10] Number of relaxation iterations per cycle.
%
% Solve equations using a Full Multigrid method.  See Press et al
% for more information.
% v = inv(A)*g
% g and v are both single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('fmg',H, g, param)
% v     - the solution n1*n2*n3*3
% H     - parameterisation of 2nd derivatives
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Number of Full Multigrid cycles.
%         - [10] Number of relaxation iterations per cycle.
%
% Solve equations using a Full Multigrid method, but using Hessian of
% the matching term.  See Press et al for more information.
% v = inv(A+H)*g
% H, g and v are all single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('cgs',H, g, param)
% v     - the solution
% H     - parameterisation of 2nd derivatives
% g     - parameterisation of first derivatives
% param - 10 parameters (settings)
%         - [1][2][3] Voxel sizes
%         - [4][5][6][7][8] Regularisation settings (see vel2mom).
%         - [9] Tolerance.  Indicates required degree of accuracy.
%         - [10] Maximum number of iterations.
%
% This is for solving a set of equations using a conjugate gradient
% solver. This method is less efficient than the Full Multigrid, and
% is included for illustrative purposes.
% v = inv(A+H)*g
% H, g and v are all single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT F = spm_diffeo('kernel',d,prm)
% d   - image dimensions
% prm - 8 parameters (settings).
%       These are described above (for 'vel2mom').
% F   - The differential operator encoded as an image (or images).
%       Convolving a velocity field by this will give the momentum.
%
%_______________________________________________________________________
%
% FORMAT y3 = spm_diffeo('comp',y1,y2)
% y1, y2 - deformation fields n1*n2*n3*3.
% y3     - deformation field field n1*n2*n3*3.
%
% Composition of two deformations y3 = y1(y2)
% y1, y2 and y3 are single precision floating point.
%
%
% FORMAT [y3,J3] = spm_diffeo('comp', y1, y2, J1, J2)
% y1, y2 - deformation fields n1*n2*n3*3.
% y3     - deformation field n1*n2*n3*3.
% J1, J2 - Jacobian tensor fields n1*n2*n3*3*3.
% J3     - Jacobian tensor field n1*n2*n3*3*3.
%
% Composition of two deformations, with their Jacobian fields.
% All fields are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT iy = spm_diffeo('invdef',y,d,M1,M2);
%
% iy - inverted deformation field of size d(1)*d(2)*d(3)*3.
% y  - original deformation field.
% M1 - An affine mapping from mm to voxels in the co-ordinate
%      system of the inverse deformation field.
% M2 - An affine mapping from voxels to mm in the co-ordinate
%      system of the forward deformation field.
%
% Inversion of a deformation field.
%
% The field is assumed to consist of a piecewise affine transformations,
% whereby each cube jointing 8 neighbouring voxels contains eight
% tetrahedra.  The mapping within each tetrahedron is assumed to be
% affine.
%
%  Reference:
%    J. Ashburner, J. Andersson and K. J. Friston (2000).
%    "Image Registration using a Symmetric Prior - in Three-Dimensions".
%    Human Brain Mapping 9(4):212-225 (appendix).
%_______________________________________________________________________
%
% FORMAT [f,dfx,dfy,dfz] = spm_diffeo('bsplins', c, y,d)
% c          - input image(s) of B-spline coefficients n1*n2*n3*n4
%              - see 'bsplinc'
% y          - points to sample n1*n2*n3*3
% d(1:3)     - degree of B-spline (from 0 to 7) along different dimensions
%              - these must be same as used by 'bsplinc'
% d(4:6)     - 1/0 to indicate wrapping along the dimensions
%
% f           - output image n1*n2*n3*n4
% dfx,dfy,dfz - sampled first derivatives
%
% c, f and y are single precision floating point.
%
% This function takes B-spline basis coefficients from spm_bsplinc,
% and re-convolves them with B-splines centred at the new sample points.
%
% Note that nearest neighbour interpolation is used instead of 0th
% degree B-splines, and the derivatives of trilinear interpolation are
% returned insted of those of 1st degree B-splines.  The difference is
% extremely subtle.
%
% c, f and y are single precision floating point.
%
%  References:
%    M. Unser, A. Aldroubi and M. Eden.
%    "B-Spline Signal Processing: Part I-Theory,"
%    IEEE Transactions on Signal Processing 41(2):821-832 (1993).
%
%    M. Unser, A. Aldroubi and M. Eden.
%    "B-Spline Signal Processing: Part II-Efficient Design and
%    Applications,"
%    IEEE Transactions on Signal Processing 41(2):834-848 (1993).
%
%    M. Unser.
%    "Splines: A Perfect Fit for Signal and Image Processing,"
%    IEEE Signal Processing Magazine, 16(6):22-38 (1999)
%
%    P. Thevenaz and T. Blu and M. Unser.
%    "Interpolation Revisited"
%    IEEE Transactions on Medical Imaging 19(7):739-758 (2000).
%
%_______________________________________________________________________
%
% FORMAT c = spm_diffeo('bsplinc',f,d)
%   f - an image
%   d(1:3) - degree of B-spline (from 0 to 7) along different dimensions
%       d(4:6) - 1/0 to indicate wrapping along the dimensions
%   c - returned volume of B-spline coefficients
%
% This function deconvolves B-splines from f, returning
% coefficients, c.  These coefficients are then passed to 'bsplins'
% in order to sample the data using B-spline interpolation.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('samp', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Sample a function according to a deformation using trilinear interp.
% f2 = f1(y)
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('push', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Push values of a function according to a deformation.  Note that the
% deformation should be the inverse of the one used with 'samp' or 'bsplins'.
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('pushc', f1, y)
% f1 - input image(s) n1*n2*n3*n4
% y  - points to sample n1*n2*n3*3
% f2 - output image n1*n2*n3*n4
%
% Push values of a function according to a deformation, but using
% circulant boundary conditions.  Data wraps around.
% f1, f2 and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT ut = spm_diffeo('pushg', u0, y)
% u0 - input momentum n1*n2*n3*3
% y  - points to sample n1*n2*n3*3
% ut - output momentum n1*n2*n3*3
%
% FORMAT ut = spm_diffeo('pushg', u0, y)
% u0 - input momentum n1*n2*n3*3
% y  - points to sample n1*n2*n3*3
% J  - Jacobian tensor field of y n1*n2*n3*3*3
% ut - output momentum n1*n2*n3*3
%
% Push values of a momentum field according to a deformation using
% circulant boundary conditions.  This essentially computes
% (Ad_y)^* u = |det dy| (dy)^T u(y), which is a key to the
% EPdiff equations used for geodesic shooting.
% u0, ut and y are single precision floating point.
%
%_______________________________________________________________________
%
% FORMAT f2 = spm_diffeo('resize', f1, dim)
% f1  - input fields n1*n2*n3*n4
% f2  - output field dim1*dim2*dim3*n4
% dim - output dimensions
%
% Resize a field according to dimensions dim.  This is a component of
% the multigrid approach, and is used for prolongation.
%
%_______________________________________________________________________
%
% FORMAT v2 = spm_diffeo('restrict', v1)
% v1  - input fields n1*n2*n3*n4
% v2  - output field dim1*dim2*dim3*n4
%
% Restricts a field such that its dimensions are approximately half
% their original.  This is a component of the multigrid approach.
%
%_______________________________________________________________________
%
% FORMAT J = spm_diffeo('def2jac',y)
% y - Deformation field
% J - Jacobian tensor field of y
%
% Compute Jacobian tensors from a deformation.
%
%_______________________________________________________________________
%
% FORMAT J = spm_diffeo('def2det',y)
% y - Deformation field
% j - Jacobian determinant field of y
%
% Compute Jacobian determinants from a deformation.
%
%_______________________________________________________________________
%
% FORMAT j = spm_diffeo('det',J)
% J - Jacobian tensor field
% j - Jacobian determinant field
%
% Compute determinants of Jacobian tensors.
%
%_______________________________________________________________________
%
% FORMAT dv = spm_diffeo('div',v)
% v  - velocity field
% dv - divergences of velocity field
%
% Computes divergence from velocity field.  This is indicative of rates
% of volumetric expansion/contraction.
%
%_______________________________________________________________________
%
% FORMAT [y,J] = spm_diffeo('smalldef',v,s)
% v - velocity field
% s - scaling factor
% y - small deformation
% J - approximate Jacobian tensors of small deformation (computed via
%     a matrix exponsntial of the Jacobians of the velocity field).
%
% This function is used for each time step of geodesic shooting.  It may
% change in future to use some form of Pade approximation of the
% small deformation.
%
%_______________________________________________________________________
%
% FORMAT v3 = spm_diffeo('brc', v1, v2)
% v1, v2, v3 - flow fields n1*n2*n3*3
%
% Lie Bracket.  Useful for many things
% e.g. Baker-Campbell-Haussdorf series expansion.
% The Lie bracket is denoted by
% v3 = [v1,v2]
% and on scalar fields, is computed by
% v3 = J1*v2 - J2*v1, where J1 and J2 are the Jacobian
% tensor fields. For matrices, the Lie bracket is simply
% [A,B] = A*B-B*A
%
%_______________________________________________________________________
%
% FORMAT v = spm_diffeo('dartel',v,g,f,param)
% v     - flow field n1*n2*n3*3 (single precision float)
% g     - first image n1*n2*n3*n4 (single precision float)
% f     - second image n1*n2*n3*n4 (single precision float)
% param - 9 parameters (settings)
%         - [1] Regularisation type, can take values of
%           - 0 Linear elasticity
%           - 1 Membrane energy
%           - 2 Bending energy
%         - [2][3][4] Regularisation parameters
%           - For "membrane energy", the parameters are
%             lambda, unused and id.
%           - For "linear elasticity", the parameters are
%             mu, lambda, and id
%           - For "bending energy", the parameters are
%             lambda, id1 and id2, such that regularisation is by
%             (-lambda*\grad^2 + id1)^2 + id2
%         - [5] Levenberg-Marquardt regularisation
%         - [6] Number of Full Multigrid cycles
%         - [7] Number of relaxation iterations per cycle
%         - [8] K, such that 2^K time points are used to
%               generate the deformations.  A value of zero
%               indicates a small deformation model.
%         - [9] code of 0, 1 or 2.
%               0 - asymmetric sums of squares objective function.
%               1 -  symmetric sums of squares objective function.
%               2 - assumes multinomial distribution, where template
%                   encodes the means and interpolation of template
%                   done using logs and softmax function.
%
% This is for performing a single iteration of the Dartel optimisation.
% All velocity fields and images are represented by single precision floating
% point values. Images can be scalar fields, in which case the objective
% function is the sum of squares difference.  Alternatively, images can be
% vector fields, in which case the objective function is the sum of squares
% difference between each scalar field + the sum of squares difference
% between one minus the sum of the scalar fields.
%
%_______________________________________________________________________
%
% FORMAT [y,J] = spm_diffeo('Exp', v, param)
% v - flow field
% J - Jacobian. Usually a tensor field of Jacobian matrices, but can
%     be a field of Jacobian determinants.
% param - 2 (or 3) parameters.
%         [1] K, the number of recursions (squaring steps), such
%             that exponentiation is done using an Euler-like
%             integration with 2^K time steps.
%         [2] a scaling parameter.
%         If there is a third parameter, and it is set to 1, then
%         the J will be the Jacobian determinants.
%
% A flow field is "exponentiated" to generate a deformation field
% using a scaling and squaring approach.  See the work of Arsigny
% et al, or Cleve Moler's "19 Dubious Ways" papers.
%
%_______________________________________________________________________
%
% Note that the boundary conditions are circulant throughout.
% Interpolation is trilinear, except for the resize function
% which uses a 2nd degree B-spline (without first deconvolving).
%
%_______________________________________________________________________
% Copyright (C) 2012 Wellcome Trust Centre for Neuroimaging

% John Ashburner
% $Id: spm_diffeo.m 4890 2012-09-03 15:19:46Z guillaume $

%-This is merely the help file for the compiled routine
error('spm_diffeo.c not compiled - see Makefile')


function res = spm_eeg_specest_morlet(S, data, time)
% Plugin for spm_eeg_tf implementing Morlet wavelet transform
% FORMAT res = spm_eeg_specest_morlet(S, data, time)
%
% S                     - input structure
% fields of S:
%    S.subsample   - factor by which to subsample the time axis (default - 1)
%  either
%    S.ncycles     - Morlet wavelet factor (default - 7)
%  or
%    S.timeres     - Fixed time window length in ms
%
%    S.frequencies - vector of frequencies (default - 0-48) at optimal frequency bins
%
% Output:
%  res -
%   If no input is provided the plugin returns a cfg branch for itself
%
%   If input is provided:
%      res.fourier - the complex output of wavelet transform
%      res.time    - time axis
%      res.freq    - frequency axis
%__________________________________________________________________________
% Copyright (C) 2010-2017 Wellcome Trust Centre for Neuroimaging

% Vladimir Litvak
% $Id: spm_eeg_specest_morlet.m 7129 2017-07-04 16:24:53Z guillaume $

%-This part if for creating a config branch that plugs into spm_cfg_eeg_tf
% Any parameters can be specified and they are then passed to the plugin
% when it's called.
%--------------------------------------------------------------------------
if nargin == 0
    subsample         = cfg_entry;
    subsample.tag     = 'subsample';
    subsample.name    = 'Subsample';
    subsample.strtype = 'n';
    subsample.num     = [1 1];
    subsample.val     = {1};
    subsample.help    = {'Set to N to subsample the time axis to every Nth sample (to reduce the dataset size).'};

    ncycles         = cfg_entry;
    ncycles.tag     = 'ncycles';
    ncycles.name    = 'Number of wavelet cycles';
    ncycles.strtype = 'n';
    ncycles.num     = [1 1];
    ncycles.val     = {7};
    ncycles.help    = {'Number of wavelet cycles (a.k.a. Morlet wavelet factor).',...
        'This parameter controls the time-frequency trade-off',...
        'Increasing it increases the frequency resolution at the expense of time resolution.'};

    timeres         = cfg_entry;
    timeres.tag     = 'timeres';
    timeres.name    = 'Fixed time window length';
    timeres.strtype = 'r';
    timeres.num     = [1 1];
    timeres.val     = {0};
    timeres.help    = {'Fixed time window for all frequencies.',...
        'Specify time window length in ms.',...
        'Default valued of 0 specifies variable time window length.'};

    morlet      = cfg_branch;
    morlet.tag  = 'morlet';
    morlet.name = 'Morlet wavelet transform';
    morlet.val  = {ncycles, timeres, subsample};

    res = morlet;

    return;
end

%-Defaults
%--------------------------------------------------------------------------
try, S.subsample; catch, S.subsample = 1; end
try, S.ncycles;   catch, S.ncycles = 7;   end

dt = time(end) - time(1);
if ~isfield(S, 'frequencies') || isempty(S.frequencies)
    S.frequencies = (1/dt):max(1/dt, floor(dt)/dt):48;
end

%-Generate wavelets
%--------------------------------------------------------------------------
if ~isfield(S, 'timeres') || S.timeres == 0
    M = spm_eeg_morlet(S.ncycles, 1000*diff(time(1:2)), S.frequencies);
else
    M = spm_eeg_morlet(S.ncycles, 1000*diff(time(1:2)), S.frequencies, 1000./S.timeres);
end

%-Data dimensions
%--------------------------------------------------------------------------
Nchannels    = size(data, 1);
Nsamples     = size(data, 2);
Nfrequencies = numel(M);

%-Initialize output struct
%--------------------------------------------------------------------------
res.freq    = S.frequencies;
res.time    = time(1:S.subsample:end);
res.fourier = zeros(Nchannels, Nfrequencies, length(res.time));

%-Compute wavelet transform
%--------------------------------------------------------------------------
for j = 1:Nchannels
    for i = 1:Nfrequencies
        tmp = conv(data(j, :), M{i});

        % time shift to remove delay
        tmp = tmp([1:Nsamples] + (length(M{i})-1)/2);

        tmp = tmp(1:S.subsample:end);

        res.fourier(j, i, :) = tmp;
    end
end

%% The following is often faster but requires more memory
%for i = 1:Nfrequencies
%    H = spm_convmtx(M{i}',Nsamples); % faster than conv for large Nchannels
%    tmp = data * H';
%    % subsample and time shift to remove delay
%    tmp = tmp(:,(1:S.subsample:Nsamples) + (length(M{i})-1)/2);
%    res.fourier(:,i,:) = tmp;
%end