% Selams, getSPLabels returns labels of Superpixels as well as number of
% total pixels in the image. It takes four parameters. One is image_input
% second one is Superpixel count limit. Third one is type. Use 1 for SLIC
% algorithm and other numbers for SLICO algorithm. BEWARE, if you are using
% type 1, which is SLIC, you have to set fourth parameter, compactness too.
% For more information, check SLIC and SLICO algorithms. If you are using
% type 2 or something else, just put random value to compactness, preferably
% ~ symbol for ignoring.
function [labels,numLabels] = getSPLabels(image_input,SPLimit,type,compactness)
% First, lets see if we have that files
conf;

% If 1 == SLIC, if 2 == SLICO
if type == 1
    [labels, numLabels] = slicmex(image_input,SPLimit,compactness);
else
    [labels, numLabels] = slicomex(image_input,SPLimit);
end

end

github-repos/MATLAB/zhangqianqianQQ-MachineVisionAlgorithm/MachineVisionAlgorithm-683338f6c3b1aab9fa2b80026915fe936aebf0ee/识别算法/Object Recognition based on super pixel/getSPLabels.m


function X = COPAR_updateX(Y, Y_range, D, X, opts)
% function X = COPAR_updateX(Y, Y_range, D, X, opts)
% updating X in COPAR.
% -----------------------------------------------
% Author: Tiep Vu, thv102@psu.edu, 5/11/2016
%         (http://www.personal.psu.edu/thv102/)
% -----------------------------------------------
    if nargin == 0
        addpath(fullfile('..', 'utils'));
        fprintf('Test most\n');
        d = 3000;
        N = 30;
        k = 20;
        k0 = 50;
        C = 100 ;
        opts.k0 = k0;
        opts.lambda = 0.01;
        opts.eta = 0.1;
        Y = normc(rand(d, C*N));
        D = normc(rand(d, C*k + k0));
        X = zeros(size(D,2), size(Y,2));
        Y_range = N*(0:C);
        opts.D_range = k* (0:C);
        opts.D_range_ext = [opts.D_range opts.D_range(end)+k0];
        opts.verbose = false;
        opts.max_iter = 30;
    end
    %%
    C = numel(Y_range) - 1;
    DtD = D'*D;
    DtY = D'*Y;
    L = 2*max(eig(DtD)) + 10;
    optsX = opts;
    optsX.max_iter = 100;
    %%
    for c = 1: C
        Xc = get_block_col(X, c, Y_range);
        X(:, Y_range(c)+1: Y_range(c+1)) = ...
            COPAR_updateXc(DtD, DtY, Y_range, Xc, c, L, optsX);
        if opts.verbose
            costXc = COPAR_cost(Y, Y_range, D, X, opts);
            fprintf('class = %3d | costXc: %5f\n', c, costXc);
        end
    end
    %%
    if nargin == 0
        X = [];
    end
end


function [n_signif,index_signif] = fdr(pvals,qlevel,method,adjustment_method,adjustment_args)
% Determine significance based on a false discovery rate (FDR) method
%
%  [n_signif,index_signif] = ...
%     fdr(pvals,qlevel,method,adjustment_method,adjustment_args)
%
% This is the main function designed for general usage for determining
% significance based on the FDR approach. The specific method used depends
% on the calling parameters.
%
% Arguments:
%
%   pvals:  a vector of pvals on which to conduct the multiple testing
%
%   qlevel: the proportion of false positives desired
%
%   method: method for performing the testing.  'original' follows
%   Benjamini & Hochberg (1995); 'general' is much more
%   conservative, requiring no assumptions on the p-values (see
%   Benjamini & Yekutieli (2001)).  We recommend using 'original',
%   and if desired, using 'adjustment.method="mean" ' to increase
%   power.
%
%   adjustment_method: method for increasing the power of the
%   procedure by estimating the proportion of alternative p-values,
%   one of 'mean', the modified Storey estimator that we suggest in
%   Ventura et al. (2004), 'storey', the method of Storey (2002),
%   or 'two-stage', the iterative approach of Benjamini et
%   al. (2001)
%
%   adjustment_args: arguments to adjustment.method; see prop_alt()
%   for description, but note that for 'two-stage', qlevel and
%   fdr_method are taken from the qlevel and method arguments to
%   fdr()
%
% Value:
%
%   index_signif:  a vector of the indices of the significant tests
%   or NA if no significant tests
%
%   n_signif: number of significant tests
%
% Examples:
%
%   signif <- fdr(pvals,method='original',adjustment.method='mean')
%
%  References:
%             Ventura, V., C.J. Paciorek, and J.S. Risbey.  2004.
%             Controlling the proportion of falsely-rejected
%             hypotheses when conducting multiple tests with
%             climatological data.  Journal of Climate, in press.
%             Also Carnegie Mellon University, Department of
%             Statistics technical report 775
%             (www.stat.cmu.edu/tr/tr775/tr775.html).
%
%             Benjamini, Y, and Y. Hochberg. 1995. Controlling the
%             false discovery rate: a practical and powerful
%             approach to multiple testing.  JRSSB 57:289-300.
%
%             Benjamini, Y. and D. Yekutieli.  2001.  The control
%             of the false discovery rate in multiple testing under
%             dependency. Annals of Statistics 29:1165-1188.
%
%             Benjamini, Y., A. Krieger, and D. Yekutieli.  2001.
%             Two staged linear step up FDR controlling procedure.
%             Technical Report, Department of Statistics and
%             Operations Research, Tel Aviv University.  URL:
%             http://www.math.tau.ac.il/~ybenja/Papers.html
%
%             Storey, J. 2002.  A direct approach to false discovery rates.  JRSSB 64: 479-498.
%
% Attribution:
%
%    Version 0.1.3;  May 10, 2004
%
%    License: GPL version 2 or later
%
% 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.
%
%
%    Author: Chris Paciorek - please contact the author with bug
%    reports: paciorek AT alumni.cmu.edu
%

if exist('isfield') % matlab
    endline='';
else % octave
    endline='\n';
end

n = length(pvals);

a = 0;   % initialize proportion of alternative hypotheses
if nargin<2
    error(['pvals and qlevel are required arguments',endline]);
end
if nargin==2
    method='original';
end
if nargin>=4 && ~isempty(adjustment_method)
    if strcmp(adjustment_method,'two-stage')  % set things up for the "two-stage" estimator
        qlevel = qlevel/(1+qlevel);   % see Benjamini et al. (2001) for proof that this controls the FDR at level qlevel
        adjustment_args.qlevel = qlevel;
        adjustment_args.fdr_method = method;
        %fprintf(['Adjusting cutoff using two-stage approach with fdr ', ...
        %    'method %s and qlevel %.3f\n'],adjustment_args.fdr_method,...
        %    adjustment_args.qlevel);
    end
    if strcmp(adjustment_method,'mean') & nargin==4  % default arguments for "mean" method of Ventura et al. (2004)
        adjustment_args.edf_lower=0.8;
        adjustment_args.num_steps=20;
        %fprintf(['Adjusting cutoff using mean approach with edf_lower=0.8 ', ...
        %    'and num_steps=20\n']);
    end
    if strcmp(adjustment_method,'storey') & nargin==4
        error(['adjustment_args.edf_quantile not specified for Storey ', ...
            'adjustment',endline]);
    end
    a = prop_alt(pvals,adjustment_method,adjustment_args);
end
if a==1    % all hypotheses are estimated to be alternatives
    index_signif=1:n;
    n_signif=n;
else      % adjust for estimate of a; default is 0
    qlevel = qlevel/(1-a);
    [n_signif,index_signif]=fdr_master(pvals,qlevel,method);
end

function [n_signif,index_signif] = fdr_master(pvals,qlevel,method)
%
% Description:
%
%    This is an internal function that performs various versions of
%    the FDR procedure, but without the modification described in
%    section 4 of Ventura et al. (2004)
%
% Arguments:
%
%   pvals (required):  a vector of pvals on which to conduct the multiple testing
%
%   qlevel: the proportion of false positives desired
%
%   method: one of 'original', the original method of Benjamini &
%   Hochberg (1995), or 'general', the method of Benjamini &
%   Yekutieli (2001), which requires no assumptions about the
%   p-values, but which is much more conservative.  We recommend
%   'original' for climatological data, and suspect it works well
%   generally for spatial data.
%
% Value:
%
%   index_signif:  a vector of the indices of the significant tests
%   or NA if no significant tests
%
%   n_signif: number of significant tests
%
%
if nargin==2
    method='original';
end
n = length(pvals);
if strcmp(method,'general')
    qlevel = qlevel/sum(1./(1:n));  % This requires fewer assumptions but is much more conservative
else
    if(~strcmp(method,'original'))
        error('No method of type: %s\n',method);
    end
end
[n_signif,index_signif] = fdr_basic(pvals,qlevel);

function [n_signif,index_signif] = fdr_basic(pvals,qlevel)
%
% Description:
%
%    This is an internal function that performs the basic FDR of Benjamini & Hochberg (1995).
%
% Arguments:
%
%   pvals:  a vector of pvals on which to conduct the multiple testing
%
%   qlevel: the proportion of false positives desired
%
% Value:
%
%   index_signif:  a vector of the indices of the significant tests
%   or NA if no significant tests
%
%   n_signif: number of significant tests
%
n = length(pvals);
if n>1 & size(pvals,2)==1
    pvals=pvals';
end
[sorted_pvals,sort_index] = sort(pvals);
indices = (1:n).*(sorted_pvals<=qlevel*(1:n)/n);
n_signif = max(indices);
if(n_signif)
    indices = 1:n_signif;
    index_signif=sort(sort_index(indices));
else
    index_signif=nan;
end

function [a] = storey(edf_quantile,pvals)
%
% Description:
%
%    This is an internal function that calculates the basic Storey
%    (2002) estimator of a, the proportion of alternative
%    hypotheses.
%
% Arguments:
%
%   edf_quantile (required):  the quantile of the empirical
%   distribution function at which to estimate a
%
%   pvals (required):  a vector of pvals on which to estimate a
%
% Value:
%
%   a: estimate of a, the number of alternative hypotheses
%
%
if exist('isfield') % matlab
    endline='';
else % octave
    endline='\n';
end
if edf_quantile >= 1 | edf_quantile <=0
    error(['edf_quantile should be between 0 and 1',endline]);
end
a = (mean(pvals<=edf_quantile)-edf_quantile)/(1-edf_quantile);
if(a<0)
    a=0;
end

function [a] = prop_alt(pvals,adjustment_method,adjustment_args)
%
% Description:
%
%    This is an internal function that calculates an estimate of a,
%    the proportion of alternative hypotheses, using one of several
%    methods.
%
% Arguments:
%
%   pvals (required):  a vector of pvals from which to estimate a
%
%   adjustment_method: method for  estimating the proportion of
%   alternative p-values, one of "mean", the modified Storey
%   estimator suggested in Ventura et al. (2004); "storey", the
%   method of Storey (2002); or "two-stage", the iterative approach
%   of Benjamini et al. (2001)
%
%   adjustment_args: arguments to adjustment.method;
%
%      for 'mean', specify edf_lower, the smallest quantile at
%      which to estimate a, and num_steps, the number of quantiles
%      to use - the approach uses the average of the Storey (2002)
%      estimator for the num.steps quantiles starting at edf.lower
%      and finishing just less than 1
%
%      for 'storey', specify edf_quantile, the quantile at which to
%      calculate the estimator
%
%      for 'two-stage', the method uses a standard FDR approach to
%      estimate which p-values are significant; this number is the
%      estimate of a; therefore the method requires specification
%      of qlevel, the proportion of false positives and fdr.method
%      ('original' or 'general'), the FDR method to be used.  We do
%      not recommend 'general' as this is very conservative and
%      will underestimate a.

%
% Value:
%
%   a:  estimate of a, the number of alternative hypotheses
%
% Examples:
%
%   a = prop_alt(pvals,'mean')
%
if exist('isfield') % matlab
    endline='';
else % octave
    endline='\n';
end

stop=0;
n = length(pvals);
if strcmp(adjustment_method,'two-stage')
    if ~exist('adjustment_args')
        stop=1;
    else
        if exist('isfield')  % check if in Matlab
            if ~(isfield(adjustment_args,'qlevel') & ...
                    isfield(adjustment_args,'fdr_method'))
                stop=1;
            end
        else  % in octave
            if ~(struct_contains(adjustment_args,'qlevel') & ...
                    struct_contains(adjustment_args,'fdr_method'))
                stop=1;
            end
        end
    end
    if stop
        error(['adjustment_args.qlevel or adjustment_args.fdr_method ', ...
            'not specified.  Two-stage estimation of the number ',...
            'of alternative hypotheses requires specification of ', ...
            'the  FDR threshold and FDR method',endline]);
    end
    [n_signif,index_signif]=fdr_master(pvals,adjustment_args.qlevel,...
        adjustment_args.fdr_method);
    a=n_signif/n;
end
if strcmp(adjustment_method,'storey')
    if ~(exist('adjustment_args'))
        stop=1;
    else
        if exist('isfield')  % check if in Matlab
            if ~(isfield(adjustment_args,'edf_quantile'))
                stop=1;
            end
        else  % octave
            if ~(struct_contains(adjustment_args,'edf_quantile'))
                stop=1;
            end
        end
    end
    if stop
        error(['adjustment_args.edf_quantile not specified. Using method of Storey for estimating  the number of alternative hypotheses requires specification of the argument of the p-value EDF at which to do the estimation (a number close to one is recommended)',endline]);
    end
    a=storey(adjustment_args.edf_quantile,pvals);
end

if strcmp(adjustment_method,'mean')
    if ~(exist('adjustment_args'))
        stop=1;
    else
        if exist('isfield')  % check if in Matlab
            if ~(isfield(adjustment_args,'edf_lower') & ...
                    isfield(adjustment_args,'num_steps'))
                stop=1;
            end
        else % octave
            if ~(struct_contains(adjustment_args,'edf_lower') & ...
                    struct_contains(adjustment_args,'num_steps'))
                stop=1;
            end
        end
    end
    if stop
        error(['adjustment_args.edf_lower or adjustment_args.num_steps ' ...
            'is not specified. Using the method of Ventura et al. (2004) for estimating  the number of alternative hypotheses requires specification of the lowest quantile of the p-value EDF at which to do the estimation (a number close to one is recommended) and the number of steps between edf_lower and 1, starting at edf_lower, at which to do the estimation',endline])
    end
    if adjustment_args.edf_lower >=1 | adjustment_args.edf_lower<=0
        error(['adjustment_args.edf_lower must be between 0 and 1',endline]);
    end
    if adjustment_args.num_steps<1 | ~(rem(adjustment_args.num_steps,1)==0)
        error(['adjustment_args.num_steps must be an integer greater than 0',endline]);
    end
    stepsize = (1-adjustment_args.edf_lower)/adjustment_args.num_steps;
    edf_quantile=adjustment_args.edf_lower;
    a_vec=storey(edf_quantile,pvals);
    for step=1:adjustment_args.num_steps
        a_vec(step)=storey(edf_quantile,pvals);
        edf_quantile=edf_quantile+stepsize;
    end
    a=mean(a_vec);
end


function l = IsLastBefore(timestamps,list,varargin)

%IsLastBefore - Identify last item before each of a list of timestamps.
%
% For each element i of a list of test timestamps, find in a list of reference timestamps
% the last element j smaller than i. Returns a list of logical indices (the elements of the
% test list which are smaller than all the elements of the reference timestamps are ignored).
%
%  USAGE
%
%    logical = IsLastBefore(timestamps,list,<options>)
%
%    timestamps     a list of reference timestamps
%    list           a list of test timestamps
%    <options>      optional list of property-value pairs (see table below)
%
%    =========================================================================
%     Properties    Values
%    -------------------------------------------------------------------------
%     'strict'      'on' for strict (<) comparisons, 'off' otherwise (<=)
%                   (default = 'off')
%    =========================================================================
%
%  SEE
%
%    See also IsFirstAfter.

% Copyright (C) 2004-2011 by Michaël Zugaro
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 3 of the License, or
% (at your option) any later version.

strict = 'off';

if nargin < 2 | mod(length(varargin),2) ~= 0,
  error('Incorrect number of parameters (type ''help IsLastBefore'' for details).');
end

% Parse parameter list
for i = 1:2:length(varargin),
  if ~ischar(varargin{i}),
    error(['Parameter ' num2str(i+1) ' is not a property (type ''help IsLastBefore'' for details).']);
  end
  switch(lower(varargin{i})),
    case 'strict',
		strict = lower(varargin{i+1});
		if ~isstring_FMAT(strict,'on','off'),
			error('Incorrect value for property ''strict'' (type ''help IsLastBefore'' for details).');
		end
    otherwise,
      error(['Unknown property ''' num2str(varargin{i}) ''' (type ''help IsLastBefore'' for details).']);
  end
end

% Make sure 'timestamps' looks like [t1;t2;...;tn] and 'list' like [l1 l2 ... lm]
if min(size(timestamps)) ~= 1 | min(size(list)) ~= 1,
	error('Incorrect sizes (must be vectors)');
end
if size(timestamps,1) == 1,
	timestamps = timestamps';
end
if size(list,2) == 1,
	list = list';
end

% Now compare [t1 t1 ... t1;t2 t2 ... t2;...;tn tn ... tn] with [l1 l2 ... lm;l1 l2 ... lm;...;l1 l2 ... lm]
if strcmp(strict,'on'),
	where = repmat(timestamps,1,length(list)) < repmat(list,length(timestamps),1);
else
	where = repmat(timestamps,1,length(list)) <= repmat(list,length(timestamps),1);
end
% This yielded something like [1 1 1;1 1 1;...;0 1 1;...;0 0 1;...;0 0 0;...;0 0 0]
% where the transition from 1 to 0 in each column indicates the index of the last element
% in 'timestamps' inferior to the corresponding element in 'list'. Now, find these transitions.
% (we append ones before and zeros after 'where' to handle the special cases where the first
% element in 'timestamps' inferior to the element of 'list' is the last element of 'timestamps'
% or does not exist).
where = diff([ones(1,size(where,2));where;zeros(1,size(where,2))]);
% Convert the resulting logical matrix into a list of logical indices
l = sum(where,2) == -1;
l = l(2:length(timestamps)+1);
l = logical(l);


function [ ] = FlipDimRunTimeAnalysis(  )

numIterations   = 100;
maxDim          = 1000;

runTime = 0;

for ii = 1:maxDim
    vX = randn([ii, 1]);
    hRunTime = tic();
    for jj = 1:numIterations
        vY = flip(vX);
    end
    runTime = runTime + toc(hRunTime);
end

disp(['Run Time - ', num2str(runTime)]);

runTime = 0;

for ii = 1:maxDim
    vX = randn([ii, 1]);
    hRunTime = tic();
    for jj = 1:numIterations
        vY = flipdim(vX, 1);
    end
    runTime = runTime + toc(hRunTime);
end

disp(['Run Time - ', num2str(runTime)]);

end


close all;
clearvars;
clc;

x = spx.ecg.synthetic.simple_multiple(500, 10);
figure;
plot(x);
xlabel('Time');
ylabel('Amplitude');
grid on;


function cnn_imagenet_minimal()
% CNN_IMAGENET_MINIMAL   Minimalistic demonstration of how to run an ImageNet CNN model

% setup toolbox
run(fullfile(fileparts(mfilename('fullpath')), ...
  '..', '..', 'matlab', 'vl_setupnn.m')) ;

% download a pre-trained CNN from the web
if ~exist('imagenet-vgg-f.mat', 'file')
  fprintf('Downloading a model ... this may take a while\n') ;
  urlwrite('http://www.vlfeat.org/matconvnet/models/imagenet-vgg-f.mat', ...
    'imagenet-vgg-f.mat') ;
end
net = load('imagenet-vgg-f.mat') ;

% obtain and preprocess an image
im = imread('peppers.png') ;
im_ = single(im) ; % note: 255 range
im_ = imresize(im_, net.meta.normalization.imageSize(1:2)) ;
im_ = im_ - net.meta.normalization.averageImage ;

% run the CNN
res = vl_simplenn(net, im_) ;

% show the classification result
scores = squeeze(gather(res(end).x)) ;
[bestScore, best] = max(scores) ;
figure(1) ; clf ; imagesc(im) ;
title(sprintf('%s (%d), score %.3f',...
   net.meta.classes.description{best}, best, bestScore)) ;


function cvx_optval = norm( x, p )

%   Disciplined convex programming information:
%       NORM is convex, except when P<1, so an error will result if
%       these non-convex "norms" are used within CVX expressions. NORM
%       is nonmonotonic, so its input must be affine.

%
% Argument map
%

persistent remap1 remap2
if isempty( remap2 ),
    remap1 = cvx_remap( 'log-convex' );
    remap2 = cvx_remap( 'affine', 'log-convex' );
end

%
% Check arguments
%

error( nargchk( 1, 2, nargin ) );
if nargin < 2,
    p = 2;
elseif ~isequal( p, 'fro' ) && ( ~isnumeric( p ) || ~isreal( p ) || p < 1 ),
    error( 'Second argument must be a real number between 1 and Inf, or ''fro''.' );
end
if ndims( x ) > 2,
    error( 'norm is not defined for N-D arrays.' );
end

[m,n] = size(x);
if m == 1 || n == 1 || isequal( p, 'fro' ),

    %
    % Vector norms
    %

    if isempty( x ),
        cvx_optval = cvx( 0 );
        return
    end
    if isequal( p, 'fro' ),
        p = 2;
    end
    x = svec( x, p );
    if length( x ) == 1,
        p = 1;
    end
    xc = cvx_classify( x );
    if ~all( remap2( xc ) ),
        error( 'Disciplined convex programming error:\n    Cannot perform the operation norm( {%s}, %g )', cvx_class( x ), p );
    end
    switch p,
        case 1,
            cvx_optval = sum( abs( x ) );
        case Inf,
            cvx_optval = max( abs( x ) );
        otherwise,
            tt = remap1( xc );
            if all( tt ),
                cvx_optval = ( sum( x .^ p ) ) .^ (1/p);
            else
                if nnz( tt ) > 1,
                    tt = tt ~= 0;
                    xx = cvx_subsref( x, tt );
                    xx = ( sum( xx .^ p ) ) .^ (1/p);
                    x  = [ cvx_subsref( x, ~tt ) ; cvx_accept_convex( xx ) ];
                end
                n = length( x );
                if p == 2,
                    cvx_begin
                        epigraph variable z
                        { x, z } == lorentz( n, [], ~isreal( x ) );
                    cvx_end
                else
                    if isreal( x ),
                        cmode = 'abs';
                    else
                        cmode = 'cabs';
                    end
                    cvx_begin
                        epigraph variable z
                        variable y( n )
                        { [ y, z*ones(n,1) ], x } == geo_mean_cone( [n,2], 2, [1/p,1-1/p], cmode );
                        sum( y ) == z;
                    cvx_end
                end
            end
    end

else

    %
    % Matrix norms
    %

    if ~cvx_isaffine( x ),
        error( 'Disciplined convex programming error:\n    Cannot perform the operation norm( {%s}, %g )\n   when the first argument is a matrix.', cvx_class( xt ), p );
    end
    switch p,
        case 1,
            cvx_optval = max( sum( abs( x ), 1 ), [], 2 );
        case Inf,
            cvx_optval = max( sum( abs( x ), 2 ), [], 1 );
        case 2,
            cvx_optval = sigma_max( x );
        otherwise,
            error( 'The only matrix norms available are 1, 2, Inf, and ''fro''.' );
    end

end

% Copyright 2010 Michael C. Grant and Stephen P. Boyd.
% See the file COPYING.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


function [] = aps_wrf_SAR()
% [] = aps_wrf_SAR()
% Script to load wrf processed data, on 37 pressure levels. Load data for area of interest,
% and calculate delays maps for each specified date.
% The DEM file inputed should have an asociated
% ".rsc" file, with the same filename as the DEM. The ".rsc" files should
% contain a WIDTH, LENGTH, X_FIRST, Y_FIRST, X_STEP, Y_STEP and optional a
% FORMAT string. The meris data is assumed to be structured in date folders.
% The batchfile contains the full path to the meris files in these folders.
% Note that the first line of the batchfile should read "files".
%
%
% INPUTS:
% demfile               Full path to the DEM file. The DEM needs to me in meters.
% xlims                 Limits in the x-direction, either in degrees
% ylims                 Limits in the y-direction, either in degrees
% demnull               The value for no DEM data, default is -32768.
% smpres                The output resolution, either in degrees
%                       Units needs to be consistend with xlims and ylims.
%
% OUTPUTS:
% It will give the computed ZENITH dry and wet delay map in cm for the selected region.
%
%     Copyright (C) 2015  Bekaert David - University of Leeds
%     Email: eedpsb@leeds.ac.uk or davidbekaert.com
%
%     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 should have received a copy of the GNU General Public License along
%     with this program; if not, write to the Free Software Foundation, Inc.,
%     51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
%
% Richard Walters/ Bekaert David - Oxford / Leeds University 2012-2013
% modifications:
% 19/11/2013    DB      Change the computation of the saturated vapor
%                       pressure over ice and water
% 19/11/2013    DB      Change the computation of the hydrostatic delay to
%                       be directly computed from pressure and temperature
% 20/11/2013    DB      Check if wrf data exist to avoid crashing
% 21/11/2013    DB      Interpolate H,Temp, Hum spatially to cope with
%                       coarser land mask compared to the DEM
% 02/01/2014	DB      fix for NaN value over sea
% 04/08/2014    DB      Redefine meris_lat(lon)_range to region_lat(lon)_range
% 24/02/2015    DB      Save support information for WRF
% 27/09/2015    DB      Separate the DEM loading, ask for number of domains.
% 28/09/2015    DB      Also save the delay computation for a grid or z to include Pirate compartibility.
% 28/09/2015    DB      Include multi-core from matlab
% 07/07/2016    DB      Redefine hydrostatic delay to be based on surface pressure.

save_complete=0;        % save support information when 0

%% Constants
% Parameters from Jolivet et al 2011, GRL
Rd = 287.05;            % [j/kg/K] specific gas constants dry air
Rv = 461.495;           % [j/kg/K] water vapour
k1 = 0.776;             % [K/Pa]
k2 = 0.716;             % [K/Pa]
k3 = 3.75e3;            % [K^2/Pa]

%% Defaults
zref = 15000;       % zref for integration- tropopause
zincr = 15;         % z increment spacing for vertical interpolation before integration
vertres = 5;        % vertical resolution for comparing dem to vert profiles of delay

%% get the number of domains
repeat=1;
while repeat==1
    action_flag= str2num(input('How many domains do you have including the parent? ','s'));
    if isnumeric(action_flag)
        n_domains = action_flag;
        repeat=0;
    end
end

%% getting the variables from the parms_aps file
stamps_processed = getparm_aps('stamps_processed',1);
ll_matfile = getparm_aps('ll_matfile',1);
wrf_datapath = getparm_aps('wrf_datapath',1);
datestructure = 'yyyymmdd';                               % assumed date structure for ERA-I
UTC_sat =  getparm_aps('UTC_sat',1);

% loading the data
if strcmp(stamps_processed,'y')
   ps = load(ll_matfile);
   dates = ps.day;
   load psver
   fprintf('Stamps processed structure \n')
else
    psver = 2;
    ifgday_matfile = getparm_aps('ifgday_matfile',1);
    ifgs_dates = load(ifgday_matfile);
    ifgs_dates = ifgs_dates.ifgday;
    dates = reshape(ifgs_dates,[],1);
    dates = unique(dates);
    dates = datenum(num2str(dates),'yyyymmdd');

end

% getting the dates
n_dates = length(dates);

%% Compute and resample DEM
[dem,xmin,xmax,ymin,ymax,smpres,nncols,nnrows] = get_DEM;

% the region which is cropped from the ERA data and used to make the interpolation.
% Should be  larger than the region to which the delay is computed
lonmin = floor(xmin)-1;
lonmax= ceil(xmax)+1;
latmin = floor(ymin)-1;
latmax = ceil(ymax)+1;

% setting the maximum height of the DEM to limit the range at whcih ERA-!
% needs to be interpolated to
maxdem = ceil(max(max(dem))/100)*100+50; % max height of dem in metres

fprintf(['Interpolate to a maximum dem height of ', num2str(maxdem) ,' m\n'])

%% performing the calucluation for each  date

for d = 1:n_dates
    date = datestr(dates(d),datestructure);
    date_str_file = datestr(dates(d),'yyyy-mm-dd');

    % the netcdf files
    infile = [wrf_datapath filesep date filesep 'wrfplev_d0' num2str(n_domains) '_' date_str_file '_' UTC_sat ':00'];
    infile2 = [wrf_datapath filesep date filesep 'wrfout_d0' num2str(n_domains) '_' date_str_file '_' UTC_sat ':00'];

    if exist(infile,'file')==2
        % the output file names
        outfile = [wrf_datapath filesep date filesep date '_ZWD.xyz'];
        hydroutfile = [wrf_datapath filesep date filesep date '_ZHD.xyz'];
        outfile2 = [wrf_datapath filesep date filesep date '_ZWD.z'];
        hydroutfile2 = [wrf_datapath filesep date filesep date '_ZHD.z'];

        % getting the information from the output file
        ncid = netcdf.open(infile,'NC_NOWRITE');
        [numdims,numvars,numglobalatts,unlimdimid] = netcdf.inq(ncid);
        [dimname, dimlen] = netcdf.inqDim(ncid,0); % dimensions
        % 3 = pressure*37
        % 6 = temperature

        % variables at each node 20 (0-19)
        [varname, vartype, dimids, natts] = netcdf.inqVar(ncid,0);

        % load variables
        Temp = netcdf.getVar(ncid,6);       % temp in K
        Hum = netcdf.getVar(ncid,7);        % relative humidity in percent
        H = netcdf.getVar(ncid,8);          % Geopotential Height in m
        Plevs = netcdf.getVar(ncid,3);      % 37 pressure levels in Pa
        netcdf.close(ncid)

        % flip the N-S axis
        Temp = flipdim(Temp,2);
        Temp = permute(Temp,[2,1,3]);
        Hum = flipdim(Hum,2);               % flip the N-S axis
        Hum = permute(Hum,[2,1,3]);
        H = flipdim(H,2);                   % flip the N-S axis
        H = permute(H,[2,1,3]);

        % replacing the non-usefull values by NaN
        Temp(Temp==-999)=NaN;
        Hum(Hum==-999)=NaN;
        H(H==-999)=NaN;

        % getting the longitude and latitude coordinates
        numlat = size(Temp,1);
        numlon = size(Temp,2);
        ncid = netcdf.open(infile2,'NC_NOWRITE');
        lats = netcdf.getVar(ncid,1);
        latgrid = repmat(lats,[1,1,37]);
        latgrid = permute(latgrid,[2,1,3]);
        latgrid = flipdim(latgrid,1);
        lons = netcdf.getVar(ncid,2);
        longrid = repmat(lons,[1,1,37]);
        longrid = permute(longrid,[2,1,3]);
        longrid = flipdim(longrid,1);
        % close netcdf file
        netcdf.close(ncid)

        % Load pressure levels and replicate vector to make 3d matrix same size as variables
        Plevs = Plevs./100; % convert into hPa (or millibars) 1000 hPa at surface
        Pressure = repmat(Plevs,[1,numlat,numlon]);
        Pressure = permute(Pressure,[2,3,1]);

        % Get list of points to look at in analysis
        [xx,yy] = meshgrid(1:numlon,1:numlat);
        latlist = reshape(latgrid(:,:,1),[],1);
        lonlist = reshape(longrid(:,:,1),[],1);
        xlist = reshape(xx,[],1);
        ylist = reshape(yy,[],1);

        % When the landmask is coarser it can introduce extreme values at
        % sharp transitions. To cope with this I perform an interpoaltion
        % over the land points, such the land mask is removed.
        % interpolate the land
        n_grid_points = size(Pressure,1)*size(Pressure,2);
        ix_vert =find(sum(sum(isnan(Temp)))==n_grid_points);
        if isempty(ix_vert)
            ix_vert = size(Temp,3);
        end
        longrid_vector = reshape(longrid(:,:,1),[],1);
        latgrid_vector= reshape(latgrid(:,:,1),[],1);

        % check for land mask only those layers that have land within them.
        parfor kkk=1:ix_vert(1)-1
             ix = find(isnan(Temp(:,:,kkk))==1);
             if ~isempty(ix)
                 Temp_temp = reshape(Temp(:,:,kkk),[],1);
                 Hum_temp = reshape(Hum(:,:,kkk),[],1);
                 H_temp = reshape(H(:,:,kkk),[],1);

                 longrid_vector_temp = longrid_vector;
                 latgrid_vector_temp = latgrid_vector;

                 % the land points that need to be interpolated
                 longrid_vector_needed = longrid_vector(ix);
                 latgrid_vector_needed = latgrid_vector(ix);

                 % removing the land poitns with currently NaN values
                 Temp_temp(ix)=[];
                 Hum_temp(ix)=[];
                 H_temp(ix)=[];

                 longrid_vector_temp(ix)=[];
                 latgrid_vector_temp(ix)=[];

                 % do the interpolation for the landpoints
                 Temp_vector_needed = griddata(double(longrid_vector_temp),double(latgrid_vector_temp),double(Temp_temp),double(longrid_vector_needed),double(latgrid_vector_needed),'linear');
                 Hum_vector_needed = griddata(double(longrid_vector_temp),double(latgrid_vector_temp),double(Hum_temp),double(longrid_vector_needed),double(latgrid_vector_needed),'linear');
                 H_vector_needed = griddata(double(longrid_vector_temp),double(latgrid_vector_temp),double(H_temp),double(longrid_vector_needed),double(latgrid_vector_needed),'linear');
                 Temp_new = Temp(:,:,kkk);
                 Hum_new = Hum(:,:,kkk);
                 H_new = H(:,:,kkk);

                 % replacing the values
                 Temp_new(ix)=Temp_vector_needed;
                 Hum_new(ix)=Hum_vector_needed;
                 H_new(ix)=H_vector_needed;

                 % storing them back in the array
                 Temp(:,:,kkk) = Temp_new;
                 Hum(:,:,kkk) = Hum_new;
                 H(:,:,kkk) =  H_new;
             end
        end
        clear Temp_new Hum_new H_new ix Temp_temp Hum_temp H_temp longrid_vector_temp latgrid_vector_temp

        % select the grid points within the area of interest
        % the projection of the grid is not uniform for the longitude as the center is defined for a specific longitude coordinate
        latlist_temp = sort(abs(diff(latlist)));
        lat_res = abs(latlist_temp(ceil(length(latlist_temp)*0.95)))*1.5;

        lonlist_temp = diff(lonlist);
        lon_res = max(abs(lonlist_temp))*1.5;

        % make sure the grid selected is covered and can be interpolated by WRF. Add a resolution cell to make sure it is the case.
        ix = find(ymin-lat_res<= latlist & latlist <= ymax+lat_res  & xmin-lon_res<= lonlist & lonlist<= xmax+lon_res) ;
        xlist = xlist(ix);
        ylist = ylist(ix);
        latlist = latlist(ix);
        lonlist = lonlist(ix);
        latlist=double(latlist);
        lonlist=double(lonlist);

        numy = length(unique(latlist));
        numx = length(unique(lonlist));
        ulatlist = unique(latlist);
        ulonlist = unique(lonlist);
        uxlist = unique(xlist);
        uylist = unique(ylist);

        if save_complete==0
            % saving the information for support plotting
            wrf.wrf_lonlat = [lonlist latlist];
            wrf.region = [[xmin xmin xmax xmax xmin]' [ymin ymax ymax ymin ymin]'];
            deminfo.xmin = xmin;
            deminfo.xmax = xmax;
            deminfo.ymax = ymax;
            deminfo.ymin = ymin;
            deminfo.dem = dem;
            wrf.deminfo = deminfo;
            clear deminfo
            % checking if the file already exist. Yes append otherwiuze create it
            if exist('tca_support.mat','file')==2
              save('tca_support.mat','-append','wrf')
            else
              save('tca_support.mat','wrf')
            end
            save_complete=1;
        end

        % Could not find the wrf used equation as they appear to be mixed
        % with latent heat etc. Istead I used the equations used in ERA-I
        % (see IFS documentation part 2: Data assimilation (CY25R1)). Calculate
        % saturated water vapour pressure (svp) for water (svpw) using Buck 1881
        % and for ice (swpi) from Alduchow and Eskridge (1996) euation AERKi
        svpw = 6.1121.*exp((17.502.*(Temp-273.16))./(240.97+Temp-273.16));
        svpi = 6.1121.*exp((22.587.*(Temp-273.16))./(273.86+Temp-273.16));
        tempbound1 = 273.16; %0
        tempbound2 = 250.16; %-23

        svp = svpw;
        % Faster expression
        wgt = (Temp - tempbound2)/(tempbound1 - tempbound2);
        svp = svpi+ (svpw - svpi).*wgt.^2; % not sure why have wgt^2, Romain does it in his pyaps code.
        ix_bound1 = find(Temp > tempbound1);
        svp(ix_bound1) = svpw(ix_bound1);
        ix_bound2 = find(Temp < tempbound2);
        svp(ix_bound2) = svpi(ix_bound2);

        e = Hum./100.*svp;
        % NB, P = Pressure in hydrostatic equation, NOT dry partial pressure as
        % stated (incorrectly) in Jolivet et al. 2011.
        P = Pressure;

        %% Convert Geopotential to Geopotential Height and then to Geometric Height
        g0 = 9.80665;

        % map of g with latitude
        g = 9.80616.*(1 - 0.002637.*cosd(2.*latgrid) + 0.0000059.*(cosd(2.*latgrid)).^2);
        % map of Re with latitude
        Rmax = 6378137;
        Rmin = 6356752;
        Re = sqrt(1./(((cosd(latgrid).^2)./Rmax^2) + ((sind(latgrid).^2)./Rmin^2)));

        %% Calculate Geometric Height, Z
        Z = (H.*Re)./(g/g0.*Re - H);

        % Find middle of scene to work out glocal and Rlocal for use later
        midx = round(mean(uxlist));
        midy = round(mean(uylist));
        glocal = g(midy,midx,1);
        Rlocal = Re(midy,midx,1);

        %% Find middle of scene to work out glocal and Rlocal for use later
        cdslices = maxdem/vertres +1;
        cdstack = zeros(size(lonlist,1),cdslices);
        cdstack_dry = zeros(size(lonlist,1),cdslices);
        cdstack_wet = zeros(size(lonlist,1),cdslices);

        XI=(0:zincr:zref)';
        gh = glocal.*(Rlocal./(Rlocal+XI)).^2; %gravity with height for XI height range

        % Interpolate Temp P and e from 0:20:15000 m
        % then integrate using trapz to estimate delay as function of height
        parfor m = 1:size(lonlist,1);
            xn = xlist(m);
            yn = ylist(m);

            %interpolate at res zincr before doing integration
            X=double(squeeze(Z(yn,xn,:)));
            YP=double(squeeze(P(yn,xn,:)));
            Ye=double(squeeze(e(yn,xn,:)));
            YT=double(squeeze(Temp(yn,xn,:)));

            YT(isnan(Ye))=[];
            YP(isnan(Ye))=[];
            X(isnan(Ye))=[];
            Ye(isnan(Ye))=[];

            YeI = interp1(X,Ye,XI,'spline')*100; %change from hPa to Pa
            YPI = interp1(X,YP,XI,'spline')*100; %change from hPa to Pa
            YTI = interp1(X,YT,XI,'spline');

            tmp1 = ((k2-(Rd*k1/Rv)).*YeI./YTI + k3.*YeI./(YTI.^2));
            Lw = (10^-6).*-1*flipud(cumtrapz(flipud(XI),flipud(tmp1)));
            % L is zenith delay one way in metres
            tmp2 = k1.*YPI./YTI;
            %Ld = (10^-6).*-1*flipud(cumtrapz(flipud(XI),flipud(tmp2)));             % This is using P/T expression (Hanssen, 2001)
            gm = glocal;
            Ld = (10^-6).*((k1*Rd/gm).*(YPI - YPI(zref/zincr +1)));                 % This is P0 expression (Hanssen, 2001)

            % Interpolate important part (i.e. total delay at elevations
            % less than maxdem) at high res i.e. vertres, and put in cdstack.
            cdI=(0:vertres:maxdem)';
            LdI=interp1(XI,Ld,cdI,'spline');
            LwI=interp1(XI,Lw,cdI,'spline');

            %cdstack(j,i,:) = LsI;
            cdstack_dry(m,:) = LdI;
            cdstack_wet(m,:) = LwI;
        end

        % Interpolate each cdstack layer onto a grid given by the DEM extents
        % in UTM m.
        xsmpres = (xmax-xmin)/nncols;
        ysmpres = (ymax-ymin)/nnrows;
        [xi,yi] = meshgrid(xmin+0.5*xsmpres:xsmpres:xmax-0.5*xsmpres,ymin+0.5*ysmpres:ysmpres:ymax-0.5*ysmpres);

        cdstack_interp_dry = zeros(nnrows,nncols,cdslices);
        parfor n = 1:cdslices
           slicelist = reshape(cdstack_dry(:,n),[],1);
           newslice = griddata(lonlist,latlist,slicelist,xi,yi,'linear');
           %F = TriScatteredInterp(lonlist,latlist,slicelist,'linear');
           %newslicelist = F(xi,yi);
           %newslice = reshape(newslicelist,nnrows,nncols);
           cdstack_interp_dry(:,:,n)= flipud(newslice); % flipud due to ypositive downpage for matlab figs, and ypositive uppage for utmy
        end

        cdstack_interp_wet = zeros(nnrows,nncols,cdslices);
        parfor n = 1:cdslices
           slicelist = reshape(cdstack_wet(:,n),[],1);
           newslice = griddata(lonlist,latlist,slicelist,xi,yi,'linear');
           %F = TriScatteredInterp(lonlist,latlist,slicelist,'linear');
           %newslicelist = F(xi,yi);
           %newslice = reshape(newslicelist,nnrows,nncols);
           cdstack_interp_wet(:,:,n)= flipud(newslice); % flipud due to ypositive downpage for matlab figs, and ypositive uppage for utmy
        end
        % keeping the coordinates in the same grid as the data
        xi = flipud(xi);
        yi = flipud(yi);

        % Pull out delays from cdstack layers that match dem heights
        wetcorrection = ones(nnrows,nncols);
        hydrcorrection = ones(nnrows,nncols);
        rounddem = round(dem/vertres);
        rounddem(dem < 0)=0;

        % cope with the case that NaN are present. This can be sea-level
        rounddem(isnan(dem))=0;

        for i=1:nnrows
            for j=1:nncols
                wetcorrection(i,j) = cdstack_interp_wet(i,j,rounddem(i,j)+1);
            end
        end

        for i=1:nnrows
            for j=1:nncols
                hydrcorrection(i,j) = cdstack_interp_dry(i,j,rounddem(i,j)+1);
            end
        end

        % note that this is a one way Zenith delay and not a slant delay.
        % Units are in cm
        % Output wet correction
        wetcorrection = wetcorrection*100;                 % delay in [cm]
        fid = fopen(outfile,'w');
        data_write =  [reshape(xi,[],1) reshape(yi,[],1) reshape(wetcorrection,[],1)]';
        tally = fwrite(fid,data_write,'double');
        fclose(fid);
        fid = fopen(outfile2,'w');
        fwrite(fid,wetcorrection','real*4');
        fclose(fid);

        % Output dry correction
        hydrcorrection = hydrcorrection*100;                 % delay in [cm]
        fid = fopen(hydroutfile,'w');
        data_write =  [reshape(xi,[],1) reshape(yi,[],1) reshape(hydrcorrection,[],1)]';
        tally = fwrite(fid,data_write,'double');
        fclose(fid);
        fid = fopen(hydroutfile2,'w');
        fwrite(fid,hydrcorrection','real*4');
        fclose(fid);

        fprintf([num2str(d) ' completed out of ' num2str(n_dates) '\n' ])

    else
        fprintf(['No wrf data for ' date ' \n'])
    end
end


function a = acot(a)
%ACOT         Gradient inverse cotangent acot(a)
%

% written  10/16/98     S.M. Rump
% modified 10/14/00     S.M. Rump  use Tony's trick
% modified 04/07/04     S.M. Rump  accelaration for sparse input
% modified 04/04/04     S.M. Rump  set round to nearest for safety
%                                    accelaration for sparse input
% modified 04/06/05     S.M. Rump  rounding unchanged
% modified 09/28/08     S.M. Rump  check for rounding to nearest improved
% modified 10/08/08     S.M. Rump  improved sparse multiplication: not using intval data type
% modified 08/26/12     S.M. Rump  global variables removed
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
    setround(0)
  end

  N = getappdata(0,'INTLAB_GRADIENT_NUMVAR');

  wng = warning;
  warning off

  % use full(a.x(:)): cures Matlab V6.0 bug
  % a=7; i=[1 1]; x=a(i), b=sparse(a); y=b(i)  yields row vector x but column vector y
  % ax is full anyway
  ax = (-1) ./ ( 1 + sqr(full(a.x(:))) );
  a.x = acot(a.x);
  if issparse(a.dx)
    sizeax = size(a.dx,1);
    [ia,ja,sa] = find(a.dx);
    if isa(a.x,'intval')
      adx = times(ax(ia),sa,0);
      if adx.complex
        a.dx = intval( sparse(ia,ja,adx.mid,sizeax,N) , sparse(ia,ja,adx.rad,sizeax,N) , 'midrad' );
      else
        a.dx = intval( sparse(ia,ja,adx.inf,sizeax,N) , sparse(ia,ja,adx.sup,sizeax,N) , 'infsup' );
      end
    else
      a.dx = sparse(ia,ja,ax(ia).*sa,sizeax,N);
    end
  else
    a.dx = a.dx .* ax(:,ones(1,N));
  end

  warning(wng);

  if rndold
    setround(rndold)
  end


function changes = get_program_changes(file_name)
% Gets the program changes in a midi file.
%
%   changes = get_program_changes(file_name)
%
% INPUTS:
%   file_name - the name of the midi file
%
% OUTPUTS:
%   changes - an Nx5 array of the patch changes.  Each row
%     is a single patch changes.  The columns are:
%        (1) the patch (instrument) number
%        (2) the time of the command in beats
%        (3) the time of the command in seconds
%        (4) the track number
%        (5) the channel
%
% 2010-05-03 Christine Smit csmit@ee.columbia.edu

import edu.columbia.ee.csmit.MidiKaraoke.read.*;
import java.io.File;
import javax.sound.midi.*;

midiFile = File(file_name);
seq = MidiSystem.getSequence(midiFile);

% get the number of ticks/quarter note, which I assume is the
% 'beat' in the nm
ticksPerQuarterNote = seq.getResolution();

changesInMidi =  ProgramChangeViewParser.parse(seq);

changes = changesInMidi.getProgramChangesDoubles();

% add 1 to the patch numbers
changes(:,1) = changes(:,1) +1;
% convert the ticks to beats...
changes(:,2) = changes(:,2)./ticksPerQuarterNote;
% add 1 to the track number
changes(:,4) = changes(:,4)+1;
% add 1 to the channel numbers
changes(:,5) = changes(:,5)+1;

end


function t_load2disp(quiet)
%T_LOAD2DISP  Tests for LOAD2DISP.

%   MATPOWER
%   Copyright (c) 2016, Power Systems Engineering Research Center (PSERC)
%   by Ray Zimmerman, PSERC Cornell
%
%   This file is part of MATPOWER.
%   Covered by the 3-clause BSD License (see LICENSE file for details).
%   See https://matpower.org for more info.

if nargin < 1
    quiet = 0;
end

num_tests = 72;

t_begin(num_tests, quiet);

[PQ, PV, REF, NONE, BUS_I, BUS_TYPE, PD, QD, GS, BS, BUS_AREA, VM, ...
    VA, BASE_KV, ZONE, VMAX, VMIN, LAM_P, LAM_Q, MU_VMAX, MU_VMIN] = idx_bus;
[GEN_BUS, PG, QG, QMAX, QMIN, VG, MBASE, GEN_STATUS, PMAX, PMIN, ...
    MU_PMAX, MU_PMIN, MU_QMAX, MU_QMIN, PC1, PC2, QC1MIN, QC1MAX, ...
    QC2MIN, QC2MAX, RAMP_AGC, RAMP_10, RAMP_30, RAMP_Q, APF] = idx_gen;
[F_BUS, T_BUS, BR_R, BR_X, BR_B, RATE_A, RATE_B, RATE_C, ...
    TAP, SHIFT, BR_STATUS, PF, QF, PT, QT, MU_SF, MU_ST, ...
    ANGMIN, ANGMAX, MU_ANGMIN, MU_ANGMAX] = idx_brch;
[PW_LINEAR, POLYNOMIAL, MODEL, STARTUP, SHUTDOWN, NCOST, COST] = idx_cost;

casefile = 't_case9_opf';
if quiet
    verbose = 0;
else
    verbose = 0;
end
if have_feature('octave')
    if have_feature('octave', 'vnum') >= 4
        file_in_path_warn_id = 'Octave:data-file-in-path';
    else
        file_in_path_warn_id = 'Octave:load-file-in-path';
    end
    s1 = warning('query', file_in_path_warn_id);
    warning('off', file_in_path_warn_id);
end

mpopt = mpoption('opf.violation', 1e-6, 'mips.gradtol', 1e-8, ...
        'mips.comptol', 1e-8, 'mips.costtol', 1e-9);
mpopt = mpoption(mpopt, 'out.all', 0, 'verbose', verbose, 'opf.ac.solver', 'MIPS');

%% set up indices
ib_data     = [1:BUS_AREA BASE_KV:VMIN];
ib_voltage  = [VM VA];
ib_lam      = [LAM_P LAM_Q];
ib_mu       = [MU_VMAX MU_VMIN];
ig_data     = [GEN_BUS QMAX QMIN MBASE:APF];
ig_disp     = [PG QG VG];
ig_mu       = (MU_PMAX:MU_QMIN);
ibr_data    = (1:ANGMAX);
ibr_flow    = (PF:QT);
ibr_mu      = [MU_SF MU_ST];
ibr_angmu   = [MU_ANGMIN MU_ANGMAX];

%% get solved AC OPF case from MAT-file
load soln9_opf;     %% defines bus_soln, gen_soln, branch_soln, f_soln

%% load2disp
mpc0 = loadcase(casefile);
mpc1 = load2disp(mpc0);
ng = size(mpc0.gen, 1);
ib = find(mpc0.bus(:, PD));
ig = ng+(1:length(ib));

t = 'mpc = load2disp(mpc) : ';
t_is(size(mpc1.gen, 1), size(mpc0.gen, 1)+length(ib), 12, [t 'number of gens']);
t_is(mpc1.bus(:, PD), 0, 12, [t 'PD is zero']);
t_is(mpc1.bus(:, QD), 0, 12, [t 'QD is zero']);
t_is(mpc1.gen(ig, PG), -mpc0.bus(ib, PD), 12, [t 'PG = -PD']);
t_is(mpc1.gen(ig, PMIN), -mpc0.bus(ib, PD), 12, [t 'PMIN = -PD']);
t_is(mpc1.gen(ig, PMAX), 0, 12, [t 'PMAX = 0']);
t_is(mpc1.gen(ig, QMIN), -mpc0.bus(ib, QD), 12, [t 'QMIN = -QD']);
t_is(mpc1.gen(ig, QMAX), 0, 12, [t 'QMAX = 0']);
t_is(mpc1.gen(ig, VG), mpc0.bus(ib, VM), 12, [t 'VG']);
t_is(mpc1.gencost(ig, MODEL), 2, 12, [t 'gencost(:, MODEL)']);
t_is(mpc1.gencost(ig, NCOST), 2, 12, [t 'gencost(:, NCOST)']);
t_is(mpc1.gencost(ig, COST), 5000, 12, [t 'gencost(:, COST)']);

t = 'mpc = load2disp(mpc, '''', idx, voll) : ';
idx = [5;7];
ig = ng+(1:length(idx));
mpc2 = load2disp(mpc0, '', idx, 1000);
t_is(size(mpc2.gen, 1), size(mpc0.gen, 1)+length(idx), 12, [t 'number of gens']);
t_is(mpc2.bus(:, PD), [zeros(8,1); 125], 12, [t 'PD']);
t_is(mpc2.bus(:, QD), [zeros(8,1);  50], 12, [t 'QD']);
t_is(mpc2.gen(ig, PG), -mpc0.bus(idx, PD), 12, [t 'PG = -PD']);
t_is(mpc2.gen(ig, PMIN), -mpc0.bus(idx, PD), 12, [t 'PMIN = -PD']);
t_is(mpc2.gen(ig, PMAX), 0, 12, [t 'PMAX = 0']);
t_is(mpc2.gen(ig, QMIN), -mpc0.bus(idx, QD), 12, [t 'QMIN = -QD']);
t_is(mpc2.gen(ig, QMAX), 0, 12, [t 'QMAX = 0']);
t_is(mpc2.gen(ig, VG), mpc0.bus(idx, VM), 12, [t 'VG']);
t_is(mpc2.gencost(ig, MODEL), 2, 12, [t 'gencost(:, MODEL)']);
t_is(mpc2.gencost(ig, NCOST), 2, 12, [t 'gencost(:, NCOST)']);
t_is(mpc2.gencost(ig, COST), 1000, 12, [t 'gencost(:, COST)']);

%% run OPF
t = 'fixed load OPF soln : ';
r0 = runopf(mpc0, mpopt);
t_ok(r0.success, [t 'success']);
t_is(r0.f, f_soln, 3, [t 'f']);
t_is(r0.bus(:,ib_data   ),    bus_soln(:,ib_data   ), 10, [t 'bus data']);
t_is(r0.bus(:,ib_voltage),    bus_soln(:,ib_voltage),  3, [t 'bus voltage']);
t_is(r0.bus(:,ib_lam    ),    bus_soln(:,ib_lam    ),  3, [t 'bus lambda']);
t_is(r0.bus(:,ib_mu     ),    bus_soln(:,ib_mu     ),  2, [t 'bus mu']);
t_is(r0.gen(:,ig_data   ),    gen_soln(:,ig_data   ), 10, [t 'gen data']);
t_is(r0.gen(:,ig_disp   ),    gen_soln(:,ig_disp   ),  3, [t 'gen dispatch']);
t_is(r0.gen(:,ig_mu     ),    gen_soln(:,ig_mu     ),  3, [t 'gen mu']);
t_is(r0.branch(:,ibr_data  ), branch_soln(:,ibr_data  ), 10, [t 'branch data']);
t_is(r0.branch(:,ibr_flow  ), branch_soln(:,ibr_flow  ),  3, [t 'branch flow']);
t_is(r0.branch(:,ibr_mu    ), branch_soln(:,ibr_mu    ),  2, [t 'branch mu']);

t = 'disp load OPF soln : ';
r1 = runopf(mpc1, mpopt);
t_ok(r0.success, [t 'success']);
t_is(r0.f, f_soln, 3, [t 'f']);
t_is(r0.bus(:,ib_data   ),    bus_soln(:,ib_data   ), 10, [t 'bus data']);
t_is(r0.bus(:,ib_voltage),    bus_soln(:,ib_voltage),  3, [t 'bus voltage']);
t_is(r0.bus(:,ib_lam    ),    bus_soln(:,ib_lam    ),  3, [t 'bus lambda']);
t_is(r0.bus(:,ib_mu     ),    bus_soln(:,ib_mu     ),  2, [t 'bus mu']);
t_is(r0.gen(:,ig_data   ),    gen_soln(:,ig_data   ), 10, [t 'gen data']);
t_is(r0.gen(:,ig_disp   ),    gen_soln(:,ig_disp   ),  3, [t 'gen dispatch']);
t_is(r0.gen(:,ig_mu     ),    gen_soln(:,ig_mu     ),  3, [t 'gen mu']);
t_is(r0.branch(:,ibr_data  ), branch_soln(:,ibr_data  ), 10, [t 'branch data']);
t_is(r0.branch(:,ibr_flow  ), branch_soln(:,ibr_flow  ),  3, [t 'branch flow']);
t_is(r0.branch(:,ibr_mu    ), branch_soln(:,ibr_mu    ),  2, [t 'branch mu']);

t = 'mpc = load2disp(solved_mpc) + gentype/genfuel : ';
r0.genfuel = {'ng'; 'coal'; 'hydro'};
r0.gentype = {'GT'; 'ST'; 'HY'};
mpc3 = load2disp(r0);
ib = find(mpc0.bus(:, PD));
ig = ng+(1:length(ib));
t_is(size(mpc3.gen, 1), size(mpc0.gen, 1)+length(ib), 12, [t 'number of gens']);
t_is(mpc3.bus(:, PD), 0, 12, [t 'PD is zero']);
t_is(mpc3.bus(:, QD), 0, 12, [t 'QD is zero']);
t_is(mpc3.gen(ig, PG), -mpc0.bus(ib, PD), 12, [t 'PG = -PD']);
t_is(mpc3.gen(ig, PMIN), -mpc0.bus(ib, PD), 12, [t 'PMIN = -PD']);
t_is(mpc3.gen(ig, PMAX), 0, 12, [t 'PMAX = 0']);
t_is(mpc3.gen(ig, QMIN), -mpc0.bus(ib, QD), 12, [t 'QMIN = -QD']);
t_is(mpc3.gen(ig, QMAX), 0, 12, [t 'QMAX = 0']);
t_is(mpc3.gen(ig, VG), r0.bus(ib, VM), 12, [t 'VG']);
t_is(mpc3.gencost(ig, MODEL), 2, 12, [t 'gencost(:, MODEL)']);
t_is(mpc3.gencost(ig, NCOST), 2, 12, [t 'gencost(:, NCOST)']);
t_is(mpc3.gencost(ig, COST), 5000, 12, [t 'gencost(:, COST)']);
t_ok(isfield(mpc3, 'gentype'), [t 'results.gentype']);
t_ok(isfield(mpc3, 'genfuel'), [t 'results.genfuel']);
if isfield(mpc3, 'gentype')
    t_ok(isequal(mpc3.gentype, {r0.gentype{:}, 'DL', 'DL', 'DL'}'), [t 'results.results.gentype']);
else
    t_ok(0, [t 'results.results.gentype']);
    got = mpc3.gentype
    expected = {r0.gentype{:}, 'DL', 'DL', 'DL'}'
end
if isfield(mpc3, 'genfuel')
    t_ok(isequal(mpc3.genfuel, {r0.genfuel{:}, 'dl', 'dl', 'dl'}'), [t 'results.results.genfuel']);
else
    t_ok(0, [t 'results.results.genfuel']);
    got = mpc3.genfuel
    expected = {r0.genfuel{:}, 'dl', 'dl', 'dl'}'
end

t = 'loadshed(mpc) : ';
shed = loadshed(mpc3.gen);
t_is(size(shed), [3 1], 12, [t 'size']);
t_is(shed, [0;0;0], 12, [t 'all zeros']);

t = 'loadshed(mpc, ild) : ';
ild = [6; 5];
shed = loadshed(mpc3.gen, ild);
t_is(size(shed), [2 1], 12, [t 'size']);
t_is(shed, [0;0], 12, [t 'all zeros']);

ild = find(isload(mpc3.gen));
mpc3.gen(ild, PG) = [-80; -100; -120];

t = 'loadshed(mpc) : ';
shed = loadshed(mpc3.gen);
t_is(size(shed), [3 1], 12, [t 'size']);
t_is(shed, [10;0;5], 12, [t 'all zeros']);

t = 'loadshed(mpc, ild) : ';
ild = [6; 5];
shed = loadshed(mpc3.gen, ild);
t_is(size(shed), [2 1], 12, [t 'size']);
t_is(shed, [5;0], 12, [t 'all zeros']);

if have_feature('octave')
    warning(s1.state, file_in_path_warn_id);
end

t_end;


%compute vx_cm
function [data,units]=compute_vx_cm(trx,n)

larvae=trx.exp2flies{n};
numlarvae=numel(larvae);
vx_cm=cell(1,numlarvae);

for i=1:numlarvae
    larva=larvae(i);
    vx_cm{1,i}=(trx(larva).x_mm(2:end)-trx(larva).x_mm(1:end-1))./trx(larva).dt;
end

units=parseunits('mm/s');
data=vx_cm;


function [c] = power(a,b,varargin)
%C=A.^B
%   [C]=POWER(A,B) Computes A.^B for a QTT-Tucker A and natural B.
%
%
% TT-Toolbox 2.2, 2009-2012
%
%This is TT Toolbox, written by Ivan Oseledets et al.
%Institute of Numerical Mathematics, Moscow, Russia
%webpage: http://spring.inm.ras.ru/osel
%
%For all questions, bugs and suggestions please mail
%ivan.oseledets@gmail.com
%---------------------------
if isa(a,'qtt_tucker') && numel(b) == 1
    c=a;
    b=b-1;
    while(b>0)
      c=c.*a;
      b=b-1;
    end

else
    error('Incorrect usage for TT-power');
end


function [net, info] = cnn_mnist(varargin)
% CNN_MNIST  Demonstrated MatConNet on MNIST

run(fullfile(fileparts(mfilename('fullpath')),...
  '..', '..', 'matlab', 'vl_setupnn.m')) ;

opts.expDir = fullfile('data','mnist-baseline') ;
[opts, varargin] = vl_argparse(opts, varargin) ;

opts.dataDir = 'data/mnist' ;
opts.imdbPath = fullfile(opts.expDir, 'imdb.mat');
opts.useBatchNorm = false ;
opts.networkType = 'simplenn' ;
opts.train = struct() ;
[opts, varargin] = vl_argparse(opts, varargin) ;

% --------------------------------------------------------------------
%                                                         Prepare data
% --------------------------------------------------------------------

net = cnn_mnist_init('useBatchNorm', opts.useBatchNorm, ...
                     'networkType', opts.networkType) ;

if exist(opts.imdbPath, 'file')
  imdb = load(opts.imdbPath) ;
else
  imdb = getMnistImdb(opts) ;
  mkdir(opts.expDir) ;
  save(opts.imdbPath, '-struct', 'imdb') ;
end

net.meta.classes.name = arrayfun(@(x)sprintf('%d',x),1:10,'UniformOutput',false) ;

% --------------------------------------------------------------------
%                                                                Train
% --------------------------------------------------------------------

switch opts.networkType
  case 'simplenn', trainfn = @cnn_train ;
  case 'dagnn', trainfn = @cnn_train_dag ;
end

[net, info] = trainfn(net, imdb, getBatch(opts), ...
  'expDir', opts.expDir, ...
  net.meta.trainOpts, ...
  opts.train, ...
  'val', find(imdb.images.set == 3)) ;

% --------------------------------------------------------------------
function fn = getBatch(opts)
% --------------------------------------------------------------------
switch lower(opts.networkType)
  case 'simplenn'
    fn = @(x,y) getSimpleNNBatch(x,y) ;
  case 'dagnn'
    bopts = struct('numGpus', numel(opts.train.gpus)) ;
    fn = @(x,y) getDagNNBatch(bopts,x,y) ;
end

% --------------------------------------------------------------------
function [images, labels] = getSimpleNNBatch(imdb, batch)
% --------------------------------------------------------------------
images = imdb.images.data(:,:,:,batch) ;
labels = imdb.images.labels(1,batch) ;

% --------------------------------------------------------------------
function inputs = getDagNNBatch(opts, imdb, batch)
% --------------------------------------------------------------------
images = imdb.images.data(:,:,:,batch) ;
labels = imdb.images.labels(1,batch) ;
if opts.numGpus > 0
  images = gpuArray(images) ;
end
inputs = {'input', images, 'label', labels} ;

% --------------------------------------------------------------------
function imdb = getMnistImdb(opts)
% --------------------------------------------------------------------
% Preapre the imdb structure, returns image data with mean image subtracted
files = {'train-images-idx3-ubyte', ...
         'train-labels-idx1-ubyte', ...
         't10k-images-idx3-ubyte', ...
         't10k-labels-idx1-ubyte'} ;

if ~exist(opts.dataDir, 'dir')
  mkdir(opts.dataDir) ;
end

for i=1:4
  if ~exist(fullfile(opts.dataDir, files{i}), 'file')
    url = sprintf('http://yann.lecun.com/exdb/mnist/%s.gz',files{i}) ;
    fprintf('downloading %s\n', url) ;
    gunzip(url, opts.dataDir) ;
  end
end

f=fopen(fullfile(opts.dataDir, 'train-images-idx3-ubyte'),'r') ;
x1=fread(f,inf,'uint8');
fclose(f) ;
x1=permute(reshape(x1(17:end),28,28,60e3),[2 1 3]) ;

f=fopen(fullfile(opts.dataDir, 't10k-images-idx3-ubyte'),'r') ;
x2=fread(f,inf,'uint8');
fclose(f) ;
x2=permute(reshape(x2(17:end),28,28,10e3),[2 1 3]) ;

f=fopen(fullfile(opts.dataDir, 'train-labels-idx1-ubyte'),'r') ;
y1=fread(f,inf,'uint8');
fclose(f) ;
y1=double(y1(9:end)')+1 ;

f=fopen(fullfile(opts.dataDir, 't10k-labels-idx1-ubyte'),'r') ;
y2=fread(f,inf,'uint8');
fclose(f) ;
y2=double(y2(9:end)')+1 ;

set = [ones(1,numel(y1)) 3*ones(1,numel(y2))];
data = single(reshape(cat(3, x1, x2),28,28,1,[]));
dataMean = mean(data(:,:,:,set == 1), 4);
data = bsxfun(@minus, data, dataMean) ;

imdb.images.data = data ;
imdb.images.data_mean = dataMean;
imdb.images.labels = cat(2, y1, y2) ;
imdb.images.set = set ;
imdb.meta.sets = {'train', 'val', 'test'} ;
imdb.meta.classes = arrayfun(@(x)sprintf('%d',x),0:9,'uniformoutput',false) ;


%                           solvePhaseMax.m
%
%  Implementation of the PhaseMax algorithm proposed in the paper using
%  FASTA. Note: For this code to run, the solver "fasta.m" must be in your
%  path.
%
%% I/O
%  Inputs:
%     A:    m x n matrix or a function handle to a method that
%           returns A*x.
%     At:   The adjoint (transpose) of 'A'. If 'A' is a function handle, 'At'
%           must be provided.
%     b0:   m x 1 real,non-negative vector consists of all the measurements.
%     x0:   n x 1 vector. It is the initial guess of the unknown signal x.
%     opts: A struct consists of the options for the algorithm. For details,
%           see header in solvePhaseRetrieval.m or the User Guide.
%
%     Note: When a function handle is used, the
%     value of 'At' (a function handle for the adjoint of 'A') must be
%     supplied.
%
%  Outputs:
%     sol:  n x 1 vector. It is the estimated signal.
%     outs: A struct consists of the convergence info. For details,
%           see header in solvePhaseRetrieval.m or the User Guide.
%
%
%  See the script 'testPhaseMaxGaussian.m' and 'testPhaseMaxFourier.m' for
%  two examples of proper usage of this function.
%
%% Notations
%
%
%% Algorithm Description
%  Solve the PhaseMax signal reconstruction problem
%         maximize <x0,x>
%         subject to |Ax|<=b0
%
%  The problem is solved by approximately enforcing the constraints using a
%  quadratic barrier function.  A continuation method is used to increase
%  the strength of the barrier function until a high level of numerical
%  accuracy is reached.
%  The objective plus the quadratic barrier has the form
%     <-x0,x> + 0.5*max{|Ax|-b,0}^2.
%
%  For a detailed explanation, see the PhaseMax paper referenced below. For
%  more details about FASTA, see the FASTA user guide, or the paper "A
%  field guide to forward-backward splitting with a FASTA implementation."
%
%% References
%  Paper Title:   PhaseMax: Convex Phase Retrieval via Basis Pursuit
%  Authors:       Tom Goldstein, Christoph Studer
%  arXiv Address: https://arxiv.org/abs/1610.07531
%
%  Copyright Goldstein & Studer, 2016.  For more details, visit
%  https://www.cs.umd.edu/~tomg/projects/phasemax/

function [sol, outs] = solvePhaseMax(A,At,b0,x0,opts)
    % Initialization
    m = length(b0);              % number of measurements
    n = length(x0);              % length of the unknown signal
    remainIters = opts.maxIters; % The remaining fasta iterations we have.
                                 % It's initialized to opts.maxIters.

    %  Normalize the initial guess relative to the number of measurements
    x0 = (x0/norm(x0(:)))*mean(b0(:))*(m/n)*100;

    %  re-scale the initial guess so that it approximately satisfies |Ax|=b
    sol = x0.* min(b0./abs(A(x0)));

    % Initialize values potentially computed at each round.
    ending = 0;       % Indicate whether any of the ending condition (except maxIters) has been met in FASTA.
    iter = 0;
    currentTime = [];
    currentResid = [];
    currentReconError = [];
    currentMeasurementError = [];

    % Initialize vectors for recording convergence information
    [solveTimes,measurementErrors,reconErrors,residuals] = initializeContainers(opts);

    %%  Define objective function components for the gradient descent method FASTA
    f = @(z) 0.5*norm(max(abs(z)-b0,0))^2;     % f(z) = 0.5*max{|x|-b,0}^2 : This is the quadratic penalty function
    gradf = @(z)  (sign(z).*max(abs(z)-b0,0)); % The gradient of the quadratic penalty

    % Options to hand to fasta
    fastaOpts.maxIters = opts.maxIters;
    fastaOpts.stopNow = @(x, iter, resid, normResid, maxResid, opts) ...
        processIteration(x, resid);  % Use customized stopNow in order to get
                                         % solveTime, residual and error at each iteration.
    fastaOpts.verbose=0;
    startTime = tic;                    % Start timer
    constraintError = norm(abs(A(sol))-b0);  % Keep track of the current error in the solution.
    while remainIters > 0 & ~ending     % Iterate over continuation steps
        g = @(x) -real(x0'*x);          % The linear part of the objective
        proxg = @(x,t) x+t*x0;          % The proximal operator of the linear objective
        fastaOpts.tol = norm(x0)/100;   % use a tighter tolerance when the solution is more exact
        % Call FASTA to solve the inner minimization problem
        [sol, fastaOuts] = fasta(A, At, f, gradf, g, proxg, sol, fastaOpts);  % Call a solver to minimize the quadratic barrier problem

        fastaOpts.tau = fastaOuts.stepsizes(end);     % Record the most recent stepsize for recycling.
        x0 = x0/10;                                   % do continuation - this makes the quadratic penalty stronger

        % Update the max number of iterations for fasta
        remainIters = remainIters - fastaOuts.iterationCount;
        fastaOpts.maxIters = min(opts.maxIters, remainIters);

        % Monitor convergence and check stopping conditions
        newConstraintError = norm(max(abs(A(sol))-b0,0));
        relativeChange = abs(constraintError-newConstraintError)/norm(b0);
        if relativeChange <opts.tol   % terminate when error reduction stalls
            break;
        end
        constraintError = newConstraintError;
    end

    % Create output according to the options chosen by user
    outs = generateOutputs(opts, iter, solveTimes, measurementErrors, reconErrors, residuals);

    % Display verbose output if specified
    if opts.verbose == 1
        displayVerboseOutput(iter, currentTime, currentResid, currentReconError, currentMeasurementError);
    end

    % Runs code upon each FASTA iteration. Returns whether FASTA should
    % terminate.
    function stop = processIteration(x, residual)
        iter = iter + 1;
        % Record convergence information and check stopping condition
        % If xt is provided, reconstruction error will be computed and used for stopping
        % condition. Otherwise, residual will be computed and used for stopping
        % condition.
        if ~isempty(opts.xt)
            xt = opts.xt;
            %  Compute optimal rotation
            alpha = (x(:)'*xt(:))/(x(:)'*x(:));
            x = alpha*x;
            currentReconError = norm(x-xt)/norm(xt);
            if opts.recordReconErrors
                reconErrors(iter) = currentReconError;
            end
        end

        if isempty(opts.xt)
            currentResid = residual;
        end

        if opts.recordResiduals
            residuals(iter) = residual;
        end

        currentTime = toc(startTime);                % Record elapsed time so far
        if opts.recordTimes
            solveTimes(iter) = currentTime;
        end
        if opts.recordMeasurementErrors
            currentMeasurementError = norm(abs(A(sol)) - b0) / norm(b0);
            measurementErrors(iter) = currentMeasurementError;
        end

        % Display verbose output if specified
        if opts.verbose == 2
            displayVerboseOutput(iter, currentTime, currentResid, currentReconError, currentMeasurementError);
        end

        % Test stopping criteria.
        stop = false;
        if currentTime >= opts.maxTime % Stop if we're run over the max runtime
            stop = true;
        end
        if ~isempty(opts.xt) % If true solution is specified, terminate when close to true solution
            assert(~isempty(currentReconError),'If xt is provided, currentReconError must be provided.');
            stop = stop || currentReconError < opts.tol;
            ending = stop;  % When true, this flag will terminate outer loop
        end
        stop = stop || residual < fastaOpts.tol;    % Stop FASTA is the tolerance is reached
    end

end


function ind = subsind(pf,varargin)
% subindexing of PoleFigure data
%

while iscell(varargin{1}), varargin = [varargin{:}];end

% pf('111') or pf({'100','110'})
if iscellstr(varargin)

  h = cellfun(@(x) string2Miller(x,pf.CS),varargin,'uniformOutput',false);

elseif isa(varargin{1},'Miller') % pf(Miller(1,0,0,cs))

  h = cellfun(@(x) pf.CS.ensureCS(x),varargin);

else % pf({1,2,3})

  ind = [varargin{:}];
  return

end

ind = [];

%
for i = 1:length(h)
  for j = 1:length(pf.allH)
    if any(isnull(angle_outer(h{i},pf.allH{j})))
      ind = [ind,j]; %#ok<AGROW>
    end
  end
end


function rv = radvl (pos, vel, velobs, star, dist)

% this function predicts the radial velocity of the observed
% object as it would be measured by spectroscopic means.  radial
% velocity is here defined as the radial velocity measure (z)
% times the speed of light.  for a solar system body, it applies
% to a fictitious emitter at the center of the observed object,
% assumed massless (no gravitational red shift), and does not
% in general apply to reflected light.  for stars, it includes
% all effects, such as gravitational red shift, contained
% in the catalog barycentric radial velocity measure, a scalar
% derived from spectroscopy.  nearby stars with a known kinematic
% velocity vector (obtained independently of spectroscopy) can be
% treated like solar system objects.  see lindegren & dravins
% (2003), astronomy & astrophysics 401, 1185-1201.
%
%      pos    = geometric position vector of object with respect to
%               observer, corrected for light-time, in au (in)
%      vel    = velocity vector of object with respect to solar
%               system barycenter, components in au/day (in)
%      velobs = velocity vector of observer with respect to solar
%               system barycenter, components in au/day (in)
%      star   = 3-element array of catalog data for a star, to be
%               non-zero if observed object is a star for which the
%               catalog radial velocity is consistent with
%               the iau definition of barycentric radial velocity
%               measure (otherwise all elements should be set to
%               0.d0 exactly) (in)
%               star(1) = catalog ra in hours
%               star(2) = catalog dec in degrees
%               star(3) = z*c, the catalog barycentric radial
%                         velocity measure times the speed of light,
%                         in kilometers/second
%               all three data elements must apply to the same
%               epoch (usually j2000.0 = jd 2451545.0 tt)
%      dist   = 3-element array of distances in au (in)
%               dist(1) = distance of observer from the geocenter
%               dist(2) = distance of observer from the sun
%               dist(3) = distance of object from the sun
%      rv     = the observed radial velocity measure times
%               the speed of light, in kilometers/second (out)

% note 1:  all the input arguments are bcrs quantities, expressed
% with respect to the icrs axes.  vel and velobs are kinematic
% velocities -- derived from geometry or dynamics, not spectroscopy.

% note 2:  if any element of array star is non-zero, the algorithm
% used will be consistent with the iau definition of stellar
% radial velocity, specifically, the barycentric radial velocity
% measure, which is derived from spectroscopy.  in that case,
% the vector vel can be very approximate -- or, for distant stars
% or galaxies, zero -- as it will be used only for a small geometric
% correction that is proportional to proper motion.

% note 3:  any of the distances in array dist can be set to zero
% (0.d0) if the corresponding general relativistic gravitational
% potential term is not to be evaluated.  these terms
% generally are important only at the meter/second level.  if
% the first two distances are both zero, an average value
% will be used for the relativistic term for the observer,
% appropriate for an observer on the surface of the earth.  the
% third distance, if given, is used only for solar system objects.

% ported from NOVAS 3.1

%%%%%%%%%%%%%%%%%%%%%%%

radcon = pi / 180.0d0;

% get au, length of astronomical unit in meters

au = astcon ('au', 1.0d0);

% get c, the speed of light in meters/second

c = astcon ('c', 1.0d0);

% get gs, heliocentric gravitational constant

gs = astcon ('gs', 1.0d0);

% get ge, geocentric gravitational constant

ge = astcon ('ge', 1.0d0);

% (gs and ge are in meters^3/second^2)

c2 = c^2;

toms = au / 86400.0d0;

toms2 = toms^2;

rv = 0.0d0;

% compute length of position vector = distance to object in au

posmag = sqrt(pos(1)^2 + pos(2)^2 + pos(3)^2);

if (posmag < 1.0d-8)

    return

end

% determine how object is to be processed

dostar = star(1) ~= 0.0d0 || star(2) ~= 0.0d0 || star(3) ~= 0.0d0;

% compute unit vector toward object

for j = 1:3

    uk(j) = pos(j) / posmag;

end

% compute velocity-squared factors

v2 = (vel(1)^2 + vel(2)^2 + vel(3)^2) * toms2;

vo2 = (velobs(1)^2 + velobs(2)^2 + velobs(3)^2) * toms2;

% compute geopotential at observer, unless observer is geocentric

r = dist(1) * au;

phigeo = 0.0d0;

if (r > 1.0d6)

    phigeo = ge / r;

end

% compute solar potential at observer

r = dist(2) * au;

phisun = 0.0d0;

if (r > 1.0d8)

    phisun = gs / r;

end

% compute relativistic potential and velocity factor for observer

if (dist(1) ~= 0.0d0 || dist(2) ~= 0.0d0)

    % lindegren & dravins eq. (41), second factor in parentheses

    rel = 1.0d0 - (phigeo + phisun) / c2 - 0.5d0 * vo2 / c2;

else

    % lindegren & dravins eq. (42), inverse

    rel = 1.0d0 - 1.550d-8;

end

if (dostar == 1)

    % for stars, update barycentric radial velocity measure for change in view angle

    ra = star(1) * 15.0d0 * radcon;

    dc = star(2) * radcon;

    du(1) = uk(1) - (cos (dc) * cos (ra));

    du(2) = uk(2) - (cos (dc) * sin (ra));

    du(3) = uk(3) - (sin (dc));

    zc = star(3) * 1.0d3 + (vel(1) * du(1) + vel(2) * du(2) + vel(3) * du(3)) * toms;

    % compute observed radial velocity measure of a star (inverse of
    % lindegren & dravins eq. (41))

    zb1 = 1.d0 + zc / c;

    kvobs = (uk(1) * velobs(1) + uk(2) * velobs(2) + uk(3) * velobs(3)) * toms;

    zobs1 = zb1 * rel / (1.0d0 + kvobs / c);

else

    % compute solar potential at object, if within solar system

    r = dist(3) * au;

    phisun = 0.0d0;

    if (r > 1.0d8 && r < 1.0d16)

        phisun = gs / r;

    end

    % compute observed radial velocity measure of a planet or other
    % object -- including a nearby star -- where kinematic
    % barycentric velocity vector is known and gravitational
    % red shift is negligible (lindegren & dravins eq. (40),
    % applied as per s. klioner private communication (2006))

    kv = (uk(1) * vel(1) + uk(2) * vel(2) + uk(3) * vel(3)) * toms;

    zb1 = (1.0d0 + kv / c) / (10.0d0 - phisun / c2 - 0.5d0 * v2 / c2);

    kvobs = (uk(1) * velobs(1) + uk(2) * velobs(2) + uk(3) * velobs(3)) * toms;

    zobs1 = zb1 * rel / (1.0d0 + kvobs / c);

end

% convert observed radial velocity measure to kilometers/second

rv = (zobs1 - 1.0d0) * c / 1000.0d0;


function batch = read_batch(model, file_list, translation)
% load the input batch from file(pre-computed mat files)
% translation: 1 for translating the data by small move and 0 for nothing.
% Hopefully, introducing translation on data would train a better model.

batch_size = length(file_list);
batch = zeros([batch_size, model.layers{1}.layerSize], 'int8');
for i = 1 : batch_size
    load(file_list(i).filename);
    if translation
        orient = randi(7);
        move = 2;
        shifted = zeros(size(instance), 'int8');
        switch orient
            case 1, % 'z'
                shifted(:,:,1:end-move) = instance(:,:,move+1:end);
            case 2, % 'z'
                shifted(:,:,move+1:end) = instance(:,:,1:end-move);
            case 3, % 'y'
                shifted(:,1:end-move,:) = instance(:,move+1:end,:);
            case 4, % 'y'
                shifted(:,move+1:end,:) = instance(:,1:end-move,:);
            case 5, % 'x'
                shifted(1:end-move,:,:) = instance(move+1:end,:,:);
            case 6, % 'x'
                shifted(move+1:end,:,:) = instance(1:end-move,:,:);
            case 7, % 'none'
                shifted = instance;
        end
    else
        shifted = instance;
    end
    batch(i,:,:,:) = shifted;
end

batch = single(batch);


function [b,stats,yadj] = repeated_ancova(X,Y,wicons,btwnnames,winames,ynames,varargin)
% Repeated measures ANCOVA with table and plot
% uses Robust IRLS
%
% :Usage:
% ::
%
%     [b,stats,yadj] = repeated_ancova(X,Y,wicons,btwnnames,winames,ynames,varargin)
%
% :Examples:
% ::
%
%    Y = rand(15,2);
%    X = Y + rand(15,2);
%    cons = [-1 1 -1 1; 1 1 -1 -1];  % placebo vs control, hot vs. warm
%
%    X = R.X(:,1:2);
%    Y = cl(2).CONTRAST.data;
%    cons = [-1 1 0 0; 0 0 -1 1];  % placebo vs control for heat then warm
%    repeated_ancova(X,Y,cons,{'Reported Placebo (C - P)' 'Order'},{'P-C Heat' 'P-C Warm'},{'CH' 'PH' 'CW' 'PW'});
%
% DOES NOT WORK WITH FIXED BTWN-SUBJECTS COVARIATES
%
% X must be a random variable that is observed multiple times for each
% subject, as does Y
%
% ..
%    tor wager, Aug. 06
% ..

dotable = 1;
doplot = 1;

for i = 1:length(varargin)
    if isstr(varargin{i})
        switch varargin{i}
            % reserved keywords
            case 'notable', dotable = 0;
            case 'noplot', doplot = 0;

            otherwise, warning(['Unknown input string option:' varargin{i}]);
        end
    end
end

[n,r] = size(Y);

y = Y(:);

obs = size(y,1); % total num observations

% get predictors for between-subjects effects
% x
% ---------------------------------------------------
if all(size(X) - [n r] == 0)
    % X is obs. x conditions for a single predictor
    nbtwn = 1;
    x = X(:);   %repmat(X,r,1);
    btwnnames = repmat(btwnnames,1,r);

elseif size(X,1) == n
    disp('Warning!!!!!! Results are not valid for fixed within-subjects contrasts.')
    % X is a between-Ss effect replicated for each measure
    nbtwn = size(X,2);
    for i = 1:nbtwn
        x(:,i) = repmat(X(:,i),r,1);
    end
end

x = scale(x,1);  % center x

% get predictors for repeated measures effects
% c
% ---------------------------------------------------
% effect of repeated measure on y (repeated condition difference in ANCOVA)
% at x = 0
c = expand_contrasts(wicons,n,r);
nwithin = size(c,2);

% get preds for interaction between continuous x and c
% xc
% ---------------------------------------------------
% difference in x-y slopes for different repeated measures in c
if nbtwn
    [xc,xcnames,ninteract] = make_interactions(nbtwn,nwithin,x,c,n,r,btwnnames,winames);
else
    xc = []; xcnames = {}; ninteract = 0;
end

% Subject effects, obs x n-1

%nused = 1 + nbtwn ;  % warning!  not sure if this is right; only needed if btwn effects are replicated for all conditions
% THE ABOVE IS BAD; CANNOT ESTIMATE MODEL WHEN X IS FIXED.

S = repmat([eye(n-1); zeros(1,n-1)], r, 1);
%S = S(:,nused+1:end);

% y is regressed on x, controlling for S, and testing c

% full model
M = [x c xc S]; M(:,end+1) = 1;
p = size(M,2);              % total num params estimated
xtxitx = pinv(M);

res = y - M * xtxitx * y;   % residuals
SSr = res' * res;           % sums of squared residuals
%dfe = obs - p;              % error df
%dfb = p - 1;                % full model df

% reduced model: Subject effects only
Mr = S; Mr(:,end+1) = 1;
res = y - Mr * pinv(Mr) * y;   % residuals
SSr2 = res' * res;              % sums of squared residuals (2)

pr = size(Mr,2);              % total num params estimated, including intercept = n
dfe = obs - pr;              % error df
MSerr = SSr2 ./ dfe;

% model comparison
SSrdiff = SSr2 - SSr;         % sums of squares explained by model params x c xc
dfdiff = p - pr;              % parameters used to explain SSrdiff
MSmodel = SSrdiff ./ dfdiff;    % mean square for non-subject, non-intercept effects in model

F = MSmodel ./ MSerr;
p = 1 - fcdf(F,dfdiff,dfe);   % all this is very approx now!!! it's late.

[b,stats] = robustfit(M,y,'bisquare',[],'off');

wh_reg = 1;

if nargout > 2
    % get which regs are of interest for fitted data
    z = get_which_of_interest(wh_reg,nbtwn,nwithin,ninteract,S);

    yadj = get_yadj(wh_reg,x,y,M,z,b,n,r);
end

% table
if dotable
    regtable(b,stats,nbtwn,nwithin,ninteract,btwnnames,winames,xcnames);
end

% plot
if doplot
    %regplot(wh_reg,b,x,y,X,Y,M,S,nbtwn,nwithin,ninteract,n,r,c,btwnnames,winames,ynames);
    regplot2(X,Y,r,stats.w,btwnnames,ynames);
    ylabel('Y');

    z = get_which_of_interest(wh_reg,nbtwn,nwithin,ninteract,S);
    yadj = get_yadj(wh_reg,x,y,M,z,b,n,r);
    regplot2(X,yadj,r,stats.w,btwnnames,ynames);

end

return

% setup: get within-subjects contrasts

function c = expand_contrasts(cons,n,r)

ncons = size(cons,1);
c = zeros(n*r,ncons);

for i = 1:ncons
    mycon = zeros(n*r,1);
    for j = 1:r
        mycon((j-1)*n+1 : j*n) = cons(i,j);
    end
    c(:,i) = mycon;
end

return

function [xc,xcnames,ninteract] = make_interactions(nbtwn,nwithin,x,c,n,r,btwnnames,winames)
ninteract = nbtwn * nwithin;
xc = zeros(n*r,ninteract);
xccounter = 1;
for i = 1:nbtwn
    for j = 1:nwithin
        xc(:,xccounter) = x(:,i) .* c(:,j);
        xcnames{xccounter} = [btwnnames{i} '*' winames{j}];
        xccounter = xccounter + 1;
    end
end
return

function regtable(b,stats,nbtwn,nwithin,ninteract,btwnnames,winames,xcnames)
fprintf(1,'Parameter\tb-hat\tt\tp\t    \n')

fprintf(1,'Between-subjects effects    \n')
wh = 1:nbtwn;       % which columns for these effects
for i=1:nbtwn
    fprintf(1,'%s\t%3.2f\t%3.2f\t%3.4f\t    \n', ...
        btwnnames{i},b(wh(i)),stats.t(wh(i)),stats.p(wh(i)));
end

fprintf(1,'Within-subjects condition effects    \n')
wh = nbtwn+1:nbtwn+nwithin;
for i=1:nwithin
    fprintf(1,'%s\t%3.2f\t%3.2f\t%3.4f\t    \n', ...
        winames{i},b(wh(i)),stats.t(wh(i)),stats.p(wh(i)));
end

fprintf(1,'Between * Within interactions    \n')
wh = nbtwn+nwithin+1 : nbtwn+nwithin+ninteract;
for i=1:ninteract
    fprintf(1,'%s\t%3.2f\t%3.2f\t%3.4f\t    \n', ...
        xcnames{i},b(wh(i)),stats.t(wh(i)),stats.p(wh(i)));
end

return

function z = get_which_of_interest(wh_reg,nbtwn,nwithin,ninteract,S)
z = zeros(1,nbtwn);
z(wh_reg) = 1;              % between of interest
z = [z ones(1,nwithin)];    % all within are of interest
zxc = zeros(1,ninteract);   % interaction effects
xccounter = 1;
for i = 1:nbtwn
    for j = 1:nwithin
        if i == wh_reg, zxc(xccounter) = 1; end
        xccounter = xccounter + 1;
    end
end
z = [z zxc];
z = [z zeros(1,size(S,2))]; % subject effects
z = [z 1];                  % intercept
z = logical(z);
return

function yadj = get_yadj(wh_reg,x,y,M,z,b,n,r);
% x (of interest) and adjusted y
xdata = reshape(x(:,wh_reg),n,r);
yadj = y - M(:,~z) * b(~z);
yadj = reshape(yadj,n,r);

function regplot2(X,Y,r,w,btwnnames,ynames)

tor_fig; set(gca,'FontSize',24)
colors = {'ro' 'gs' 'cv' 'mh'};
for i = 1:r
    h = plot_correlation(X(:,i),Y(:,i),'colors',colors(i),'robust','noprint','weights',w);
    han(i) = h{1}(1);
end

han2 = findobj(gcf,'Type','text');
delete(han2)

% range over which to get fits for line
xrange = max(X(:,1)) - min(X(:,1));
minx = min(X(:,1)) - .1*xrange;
maxx = max(X(:,1)) + .1*xrange;

set(gca,'XLim',[minx maxx]);

% Y range
yrange = max(Y(:)) - min(Y(:));
miny = min(Y(:)) - .1*yrange;
maxy = max(Y(:)) + .1*yrange;
set(gca,'YLim',[miny maxy]);

xlabel(btwnnames{1});
ylabel('Adjusted data');
%ynames = {'HC' 'HA' 'LC' 'LA'};
legend(han,ynames)

scn_export_papersetup(400);

return

% OLD FUNCTION--but a goodie.  this was for fixed regressors btwn.
function regplot(wh_reg,b,x,y,X,Y,M,S,nbtwn,nwithin,ninteract,n,r,c,btwnnames,winames,ynames)

npar = nbtwn+nwithin+ninteract;

% only significant betas
% sig = stats.p < .10;
% sig = sig(1:npar);
% bsig = b(1:npar) .* sig;
% bsig = [bsig; b(end)];

% all betas for btwn of interest and w/i conditions
% bsig = zeros(1,npar)';
% bsig(wh_reg) = b(wh_reg);  % regressor of interest
% wh = nbtwn+1:nbtwn+nwithin; % condition, within Ss effects
% bsig(wh) = b(wh);
% wh = nbtwn+nwithin+1:npar; % interactions with reg of interest
% wh = wh(1:2);           %%%%%kludgy fix for reg 1 only
% bsig(wh) = b(wh);
% bsig = [bsig; b(end)];

% range over which to get fits for line
xrange = max(X(:,1)) - min(X(:,1));
minx = min(X(:,1)) - .1*xrange;
maxx = max(X(:,1)) + .1*xrange;

% get predicted values for this btwn effect (xf)
x2 = linspace(minx,maxx,n)';
x2 = repmat(x2,1,r);
x2 = x2(:);
xf = x;
xf(:,wh_reg) = x2;

% get interactions
[xcf,xcnamesf,ninteract] = make_interactions(nbtwn,nwithin,xf,c,n,r,btwnnames,winames);

% Model for pred values
Mf = [xf c xcf S];
Mf(:,end+1) = 1;

% get which regs are of interest for fitted data
z = get_which_of_interest(wh_reg,nbtwn,nwithin,ninteract,S);

%fit lines
f = Mf(:,z) * b(z);          % fitted data (for lines)
f = reshape(f,n,r);         % fits
xfit = reshape(x2,n,r);   % x values for fits

% x (of interest) and adjusted y
xdata = X;
%xdata = reshape(x(:,wh_reg),n,r);
yadj = y - M(:,~z) * b(~z);
yadj = reshape(yadj,n,r);

% make figure
tor_fig; set(gca,'FontSize',24)
colors = {'ro' 'bs' 'kv' 'gp'};
for i = 1:r
    plot(xdata(:,i),yadj(:,i),colors{i},'MarkerFaceColor',colors{i}(1));  % adjusted data
    han(i) = plot(xfit(:,i),f(:,i),[colors{i}(1) '-']);    % fit line
end

xlabel(btwnnames{wh_reg});
ylabel('Adjusted data');
%ynames = {'HC' 'HA' 'LC' 'LA'};
legend(han,ynames)

set(gca,'XLim',[minx maxx]);

% Y range
yrange = max(yadj(:)) - min(yadj(:));
miny = min(yadj(:)) - .1*yrange;
maxy = max(yadj(:)) + .1*yrange;
set(gca,'YLim',[miny maxy]);

scn_export_papersetup(400);

return


function BF_PlotCorrMat(D_corr,rangeHow,makeFigure)
% BF_PlotCorrMat    Visualization of a pairwise similarity matrix
%
% Attempts to determine a set of smaller clusters of objects showing similar
% behavior.
%
%---INPUTS:
% D_corr, a pairwise distance matrix
% rangeHow, the colorbar extent: (i) 'auto' (automatic)
%                                (ii) '-1to1' (range from -1 to 1)
%                                (iii) '0to1' (range from 0 to 1)
%                                (iv) 'balanced' (range from -X to X, for max possible X)
%                                (v) 'positive' (range from 0 to X, for max possible X)
% makeFigure, whether to generate a new figure

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This work is licensed under the Creative Commons
% Attribution-NonCommercial-ShareAlike 4.0 International License. To view a copy of
% this license, visit http://creativecommons.org/licenses/by-nc-sa/4.0/ or send
% a letter to Creative Commons, 444 Castro Street, Suite 900, Mountain View,
% California, 94041, USA.
% ------------------------------------------------------------------------------

%-------------------------------------------------------------------------------
% Check inputs, set defaults:
%-------------------------------------------------------------------------------

if nargin < 2 || isempty(rangeHow)
    rangeHow = 'auto';
end
if nargin < 3
    makeFigure = false;
end

%-------------------------------------------------------------------------------
% Make a matrix
if any(size(D_corr)==1)
    D_corr = squareform(D_corr);
end

% Open a new figure window:
if makeFigure
    f = figure('color','w');
end

% Plot the image:
imagesc(D_corr)

axis square

%-------------------------------------------------------------------------------
% Set color limits and colormap

% If auto setting, can set to balanced if both positive and negative
if strcmp(rangeHow,'auto')
    if any(D_corr(:) > 0) && any(D_corr(:) < 0)
        rangeHow = 'balanced';
    end
end

switch rangeHow
case 'positive'
    maxDev = max(D_corr(:));
    caxis([0,maxDev])
    colormap(BF_GetColorMap('greenblue',9,0))
case 'balanced'
    maxDev = max(abs(D_corr(:)));
    caxis([-maxDev,maxDev])
    colormap([flipud(BF_GetColorMap('blues',9,0));[1,1,1],;BF_GetColorMap('reds',9,0)])
case 'n1to1'
    caxis([-1,1])
    colormap([flipud(BF_GetColorMap('blues',9,0));BF_GetColorMap('reds',9,0)])
case '0to1' % assume 0-1 range (a normalized distance metric)
    caxis([0,1])
    colormap([1,1,1;BF_GetColorMap('reds',9,0)])
case 'auto'
    colormap(flipud(gray(64)))
otherwise
    error('Unknown colormap range option: ''%s''',rangeHow);
end

% ------------------------------------------------------------------------------
% Superimpose black rectangles over NaN values

if any(isnan(D_corr(:)))
    [theNaNs_i,theNaNs_j] = find(isnan(D_corr));
    for i = 1:length(theNaNs_i)
        rectangle('Position',[theNaNs_j(i)-0.5,theNaNs_i(i)-0.5,1,1],'FaceColor','k', ...
                        'EdgeColor','k')
    end
end

% Remove ticks:
set(gca,'TickLength',[0,0])

end


function pass = test_isreal()
% Test chebfun3/isreal.

f = chebfun3(@(x,y,z) x+y-z);
pass(1) = isreal(f);

f = chebfun3(@(x,y,z) 1i*x+y-z);
pass(2) = ~isreal(f);

f = real(chebfun3(@(x,y,z) 1i*x+y-z));
pass(3) = isreal(f);

end


function [c, s, b, g, active_set] = foopsi_oasisAR1(y, g, lam, smin, optimize_b,...
    optimize_g, decimate, maxIter, tau_range, gmax)
%% Infer the most likely discretized spike train underlying an AR(1) fluorescence trace
% Solves the sparse non-negative deconvolution problem
%  min 1/2|c-y|^2 + lam |s|_1 subject to s_t = c_t-g c_{t-1} >= 0

%% inputs:
%   y:  T*1 vector, One dimensional array containing the fluorescence intensities
%withone entry per time-bin.
%   g:  scalar, Parameter of the AR(1) process that models the fluorescence ...
%impulse response.
%   lam:  scalar, sparsity penalty parameter
%   optimize_b: bool, optimize baseline if True
%   optimize_g: integer, number of large, isolated events to consider for
%       optimizing g
%   decimate: int, decimation factor for estimating hyper-parameters faster
%       on decimated data
%   maxIter:  int, maximum number of iterations
%   active_set: npool x 4 matrix, warm stared active sets
%   gmax:  scalar, maximum value of g
%   tau_range: [tau_min, tau_max]
%% outputs
%   c: T*1 vector, the inferred denoised fluorescence signal at each time-bin.
%   s: T*1 vector, discetized deconvolved neural activity (spikes)
%   b: scalar, fluorescence baseline
%   g: scalar, parameter of the AR(1) process
%   active_set: npool x 4 matrix, active sets

%% Authors: Pengcheng Zhou, Carnegie Mellon University, 2016
% ported from the Python implementation from Johannes Friedrich

%% References
% Friedrich J et.al., NIPS 2016, Fast Active Set Method for Online Spike Inference from Calcium Imaging

%% input arguments
y = reshape(y, [], 1);
T = length(y);

if ~exist('g', 'var') || isempty(g)
    g = estimate_time_constant(y, 1);
end
if ~exist('lam', 'var') || isempty(lam);   lam = 0; end
if ~exist('smin', 'var') || isempty(smin)
    smin = 0;
elseif smin<0
    smin = abs(smin) * GetSn(y);     % use a threshold that is proportional to the noise level
end
if ~exist('optimize_b', 'var') || isempty(optimize_b)
    optimize_b = false;
end
if ~exist('optimize_g', 'var') || isempty(optimize_g)
    optimize_g = 0;
end
if ~exist('decimate', 'var') || isempty(decimate)
    decimate = 1;
else
    decimate = max(1, round(decimate));
end
if ~exist('maxIter', 'var') || isempty(maxIter)
    maxIter = 10;
end
if ~exist('tau_range', 'var') || isempty(tau_range)
   g_range = [0, 1];
else
   g_range = exp(-1./tau_range);
   g = min(max(g, g_range(1)), g_range(2));
end

% change parameters due to downsampling
if decimate>1
    decimate = 1;  %#ok<NASGU>
    disp('to be done');
    %     fluo = y;
    %     y = resample(y, 1, decimate);
    %     g = g^decimate;
    %     thresh = thresh / decimate / decimate;
    %     T = length(y);
end

%% optimize parameters
if ~optimize_b   %% don't optimize the baseline b
    %% initialization
    b = 0;
    [solution, spks, active_set] = oasisAR1(y, g, lam, smin);

    %% iteratively update parameters g
    if  optimize_g     % update g
        [solution, active_set, g, spks] = update_g(y, active_set,lam, smin, g_range);
    end
else
    %% initialization
    b = quantile(y, 0.15);
    [solution, spks, active_set] = oasisAR1(y-b, g, lam, smin);

    %% iteratively update parameters g and b
    for m=1:maxIter
        b = mean(y-solution);
        if  optimize_g     % update g
            if size(active_set, 1) == 0
                break;
            end
            g0 = g;
            if g>gmax  % spike counts are too small. stop
                g = estimate_time_constant(y, 1);
                [solution, spks, active_set] = oasisAR1(y-b, g, lam, smin);
                break;
            end
            [solution, active_set, g, spks] = update_g(y-b, active_set,lam, smin, g_range);
            if abs(g-g0)/g0 < 1e-3  % g is converged
                optimize_g = false;
            end
        else
            break;
        end
    end
end
c = solution;
s = spks;
end
%update the AR coefficient: g
function [c, active_set, g, s] = update_g(y, active_set, lam, smin, g_range)
%% inputs:
%   y:  T*1 vector, One dimensional array containing the fluorescence intensities
%withone entry per time-bin.
%   active_set: npools*4 matrix, previous active sets.
%   lam:  scalar, curret value of sparsity penalty parameter lambda.

%% outputs
%   c: T*1 vector
%   s: T*1 vector, spike train
%   active_set: npool x 4 matrix, active sets
%   g: scalar

%% Authors: Pengcheng Zhou, Carnegie Mellon University, 2016
% ported from the Python implementation from Johannes Friedrich

%% References
% Friedrich J et.al., NIPS 2016, Fast Active Set Method for Online Spike Inference from Calcium Imaging

%% initialization
if ~exist('g_range', 'var') || isempty(g_range)
   g_range = [0, 1];
end
len_active_set = size(active_set, 1);  %number of active sets
y = reshape(y,[],1);    % fluorescence data
maxl = max(active_set(:, 4));   % maximum ISI
c = zeros(size(y));     % the optimal denoised trace

%% find the optimal g and get the warm started active_set
h = [];
g = fminbnd(@rss_g, g_range(1), g_range(2));
yp = y - lam*(1-g);
for m=1:len_active_set
    tmp_h = exp(log(g)*(0:maxl)');   % response kernel
    tmp_hh = cumsum(h.*h);        % hh(k) = h(1:k)'*h(1:k)
    li = active_set(m, 4);
    ti = active_set(m, 3);
    idx = ti:(ti+li-1);
    active_set(m,1) = (yp(idx))'*tmp_h(1:li);
    active_set(m,2) = tmp_hh(li);
end
[c,s,active_set] = oasisAR1(y, g, lam, smin, active_set);

%% nested functions
    function rss = rss_g(g)
        h = exp(log(g)*(0:maxl)');   % response kernel
        hh = cumsum(h.*h);        % hh(k) = h(1:k)'*h(1:k)
        yp = y - lam*(1-g);     % include the penalty term
        for ii=1:len_active_set
            li = active_set(ii, 4);
            ti = active_set(ii, 3);
            idx = ti:(ti+li-1);
            tmp_v = max(yp(idx)' * h(1:li) / hh(li), 0);
            c(idx) = tmp_v*h(1:li);
        end
        res = y-c;
        rss = res'*res;     % residual sum of squares
    end
end


nProj = size(uproj,2);

uBase = zeros(1e4, nProj);
nS = zeros(1e4, 1);
ncurr = 1;

for ibatch = 1:numel(indBatch)
    % merge in with existing templates
    uS = uproj(indBatch{ibatch}, :);
    [nSnew, iNonMatch] = merge_spikes0(uBase(1:ncurr,:), nS(1:ncurr), uS, ops.crit);
    nS(1:ncurr) = nSnew;
    %
    % reduce non-matches
    [uNew, nSadd] = reduce_clusters0(uS(iNonMatch,:), ops.crit);

    % add new spikes to list
    uBase(ncurr + [1:size(uNew,1)], :) = uNew;
    nS(ncurr + [1:size(uNew,1)]) = nSadd;

    ncurr = ncurr + size(uNew,1);

    if ncurr>1e4
        break;
    end
end
%
nS = nS(1:ncurr);
uBase = uBase(1:ncurr, :);

[~, itsort] = sort(nS, 'descend');

%% initialize U
% compute covariance matrix
sigDrift = 15;
sigShift = 20;
chanDists= bsxfun(@minus, rez.yc, rez.yc').^2 + bsxfun(@minus, rez.xc, rez.xc').^2;
iCovChans = my_inv(exp(-chanDists/(2*sigDrift^2)), 1e-6);

Nfilt = ops.Nfilt;
lam = ops.lam(1) * ones(Nfilt, 1, 'single');

U = gpuArray(uBase(itsort(1:Nfilt), :))';
mu = sum(U.^2,1)'.^.5;
U = normc(U);
%
deltay = zeros(ops.Nchan, numel(indBatch));

for i = 1:10
    % resample spatial masks up and down
    Uup   = shift_data(reshape(U, ops.Nchan, []),  sigShift, rez.yc, rez.xc, iCovChans, sigDrift, rez.Wrot);
    Uup   = reshape(Uup, size(U));
    Udown = shift_data(reshape(U, ops.Nchan, []), -sigShift, rez.yc, rez.xc, iCovChans, sigDrift, rez.Wrot);
    Udown = reshape(Udown, size(U));

    mu = repmat(mu, 3, 1);
    lam = repmat(lam, 3, 1);

    dWU = zeros(Nfilt, nProj, 'single');
    nToT = gpuArray.zeros(Nfilt, 1, 'single');
    Cost = gpuArray(single(0));
    %
    for ibatch = 1:numel(indBatch)
        % find clusters
        clips = gpuArray(uproj(indBatch{ibatch}, :))';
        nSpikes = size(clips,2);
        clips = reshape(clips, ops.Nchan, []);

        % resample clips by the delta y
        clips = shift_data(clips, deltay(:, ibatch), rez.yc, rez.xc, iCovChans, sigDrift, rez.Wrot);
        clips = reshape(clips, size(U,1), [])';

        ci = clips * [Udown U Uup];

        ci = bsxfun(@plus, ci, (mu .* lam)');
        cf = bsxfun(@rdivide, ci.^2, 1 + lam');
        cf = bsxfun(@minus, cf, (mu.^2.*lam)');

        cf = reshape(cf,[], Nfilt, 3);
        [Mmax, imax] = max(cf, [], 2);
        [~, i3max] = max(Mmax, [], 3);
%         keyboard;

        % determine added correction to delta y

        % determine cluster assignment for this iteration
        [max_cf, id] = max(cf(:,:,2), [], 2);
        id = gather_try(id);
        L = gpuArray.zeros(Nfilt, nSpikes, 'single');
        L(id' + [0:Nfilt:(Nfilt*nSpikes-1)]) = 1;
        dWU = dWU + L * clips;
        nToT = nToT + sum(L, 2);
        Cost = Cost + mean(max_cf);
    end
    dWU  = bsxfun(@rdivide, dWU, nToT);

    U = dWU';
    mu = sum(U.^2,1)'.^.5;
    U = normc(U);
    Cost = Cost/size(inds,2);

    % smooth out corrections

    %     disp(Cost)

    %     plot(sort(log(1+nToT)))
    %     drawnow
end
%%
Nchan = ops.Nchan;
Nfilt = ops.Nfilt;
wPCA = ops.wPCA(:,1:3);
Urec = reshape(U, Nchan, size(wPCA,2), Nfilt);

nt0 = 61;
Urec= permute(Urec, [2 1 3]);
Wrec = reshape(wPCA * Urec(:,:), nt0, Nchan, Nfilt);

Wrec = gather_try(Wrec);
Nrank = 3;
W = zeros(nt0, Nfilt, Nrank, 'single');
U = zeros(Nchan, Nfilt, Nrank, 'single');
for j = 1:Nfilt
    [w sv u] = svd(Wrec(:,:,j));
    w = w * sv;

    Sv = diag(sv);
    W(:,j,:) = w(:, 1:Nrank)/sum(Sv(1:ops.Nrank).^2).^.5;
    U(:,j,:) = u(:, 1:Nrank);
end

Uinit = U;
Winit = W;
mu = gather_try(single(mu));
muinit = mu;

WUinit = zeros(nt0, Nchan, Nfilt);
for j = 1:Nfilt
    WUinit(:,:,j) = muinit(j)  * Wrec(:,:,j);
end
WUinit = single(WUinit);
%%