% Sample codes for the task-related component analysis (TRCA)-based steady
% -state visual evoked potential (SSVEP) detection method [1]. The filter
% bank analysis [2] can also be combined to the TRCA-based algorithm.
%
% Dataset (sample.mat):
%   A 40-target SSVEP dataset recorded from a single subject. The stimuli
%   were generated by the joint frequency-phase modulation (JFPM) [3]
%     - Stimulus frequencies    : 8.0 - 15.8 Hz with an interval of 0.2 Hz
%     - Stimulus phases         : 0pi, 0.5pi, 1.0pi, and 1.5pi
%     - # of channels           : 9 (1: Pz, 2: PO5,3:  PO3, 4: POz, 5: PO4,
%                                    6: PO6, 7: O1, 8: Oz, and 9: O2)
%     - # of recording blocks   : 6
%     - Data length of epochs   : 5 [seconds]
%     - Sampling rate           : 250 [Hz]
%
% See also:
%   train_trca.m
%   test_trca.m
%   filterbank.m
%   itr.m
%
% Reference:
%   [1] M. Nakanishi, Y. Wang, X. Chen, Y.-T. Wang, X. Gao, and T.-P. Jung,
%       "Enhancing detection of SSVEPs for a high-speed brain speller using
%        task-related component analysis",
%       IEEE Trans. Biomed. Eng, 65(1): 104-112, 2018.
%   [2] X. Chen, Y. Wang, S. Gao, T. -P. Jung and X. Gao,
%       "Filter bank canonical correlation analysis for implementing a
%        high-speed SSVEP-based brain-computer interface",
%       J. Neural Eng., 12: 046008, 2015.
%   [3] X. Chen, Y. Wang, M. Nakanishi, X. Gao, T. -P. Jung, S. Gao,
%       "High-speed spelling with a noninvasive brain-computer interface",
%       Proc. Int. Natl. Acad. Sci. U. S. A, 112(44): E6058-6067, 2015.
%
% Masaki Nakanishi, 22-Dec-2017
% Swartz Center for Computational Neuroscience, Institute for Neural
% Computation, University of California San Diego
% E-mail: masaki@sccn.ucsd.edu

%% Clear workspace
clear all
close all
clc
help tutorial_trca

%% Set paths

addpath('../src');

%% Parameter for analysis (Modify according to your analysis)

% Filename
filename = '../data/sample.mat';

% Data length for target identification [s]
len_gaze_s = 0.5;

% Visual latency being considered in the analysis [s]
len_delay_s = 0.13;

% The number of sub-bands in filter bank analysis
num_fbs = 5;

% 1 -> The ensemble TRCA-based method, 0 -> The TRCA-based method
is_ensemble = 0;

% 100*(1-alpha_ci): confidence intervals
alpha_ci = 0.05;

%% Fixed parameter (Modify according to the experimental setting)

% Sampling rate [Hz]
fs = 250;

% Duration for gaze shifting [s]
len_shift_s = 0.5;

% List of stimulus frequencies
list_freqs = [8:1:15 8.2:1:15.2 8.4:1:15.4 8.6:1:15.6 8.8:1:15.8];

% The number of stimuli
num_targs = length(list_freqs);

% Labels of data
labels = [1:1:num_targs];

%% Preparing useful variables (DONT'T need to modify)

% Data length [samples]
len_gaze_smpl = round(len_gaze_s*fs);

% Visual latency [samples]
len_delay_smpl = round(len_delay_s*fs);

% Selection time [s]
len_sel_s = len_gaze_s + len_shift_s;

% Confidence interval
ci = 100*(1-alpha_ci);

%% Performing the TRCA-based SSVEP detection algorithm

fprintf('Results of the ensemble TRCA-based method.\n');

% Preparing data
load(filename);
[~, num_chans, ~, num_blocks] = size(eeg);
segment_data = len_delay_smpl+1:len_delay_smpl+len_gaze_smpl;
eeg = eeg(:, :, segment_data, :);

% Estimate classification performance
for loocv_i = 1:1:num_blocks

    % Training stage
    traindata = eeg;
    traindata(:, :, :, loocv_i) = [];
    model = train_trca(traindata, fs, num_fbs);

    % Test stage
    testdata = squeeze(eeg(:, :, :, loocv_i));
    estimated = test_trca(testdata, model, is_ensemble);

    % Evaluation
    is_correct = (estimated==labels);
    accs(loocv_i) = mean(is_correct)*100;
    itrs(loocv_i) = itr(num_targs, mean(is_correct), len_sel_s);
    fprintf('Trial %d: Accuracy = %2.2f%%, ITR = %2.2f bpm\n',...
        loocv_i, accs(loocv_i), itrs(loocv_i));

end % loocv_i

% Summarize
[mu, ~, muci, ~] = normfit(accs, alpha_ci);
fprintf('Mean accuracy = %2.2f %% (%2d%% CI: %2.2f - %2.2f %%)\n',...
    mu, ci, muci(1), muci(2));

[mu, ~, muci, ~] = normfit(itrs, alpha_ci);
fprintf('Mean ITR = %2.2f bpm (%2d%% CI: %2.2f - %2.2f bpm)\n\n',...
    mu, ci, muci(1), muci(2));


function [retransformed_irf_estimates]=favar_retransX_irf_estimates(irf_estimates,transformationindex,levels)
% number of variables and shocks, and iterations (It-Bu)
[n1,n2]=size(irf_estimates);
ItBu=1;
% initialise
retransformed_irf_estimates=cell(size(irf_estimates));
% different treatment for different cases
if levels==1 % only cum sum, also for second differences
    for oo=1:n1 % variables
        for ll=1:n2 % shocks
            for ii=1:3 %for up.,median,low.
                if transformationindex(oo)==1 %1: no transformation, Level
                    retransformed_irf_estimates{oo,ll}(ii,:)=irf_estimates{oo,ll}(ii,:);
                elseif transformationindex(oo)==2
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(irf_estimates{oo,ll}(ii,:),2); %2: First Difference
%                     retransformed_irf_estimates{oo,ll}(ii,:)=irf_estimates{oo,ll}(ii,:);
                elseif transformationindex(oo)==3
                    %retransformed_irf_record{oo,ll}(ii,:)=cumsum(irf_record{oo,ll}(ii,:),2);    %3: Second Difference
                    retransformed_irf_estimates{oo,ll}(ii,:)=irf_estimates{oo,ll}(ii,:);
                elseif transformationindex(oo)==4
                    %retransformed_irf_record{oo,ll}(ii,:)=irf_record{oo,ll}(ii,:);
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(irf_estimates{oo,ll}(ii,:))-ones(ItBu,1);       %4: Log-Level
                elseif transformationindex(oo)==5
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(irf_estimates{oo,ll}(ii,:),2); %5: Log-First-Difference
%                     retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(irf_estimates{oo,ll}(ii,:),2))-ones(ItBu,1); %5: Log-First-Difference
                elseif transformationindex(oo)==6
                    %retransformed_irf_record{oo,ll}(ii,:)=cumsum(irf_record{oo,ll}(ii,:),2); %6: Log-Second-Difference
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(irf_estimates{oo,ll}(ii,:),2))-ones(ItBu,1); %5: Log-First-Difference
                end
            end
        end
    end
elseif levels==2 % exp + cum sum
    for oo=1:n1 % variable
        for ll=1:n2 % shocks
            for ii=1:3 %for up.,median,low.
                if transformationindex(oo)==1 %1: no transformation, Level
                    retransformed_irf_estimates{oo,ll}(ii,:)=irf_estimates{oo,ll}(ii,:);
                elseif transformationindex(oo)==2
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(irf_estimates{oo,ll}(ii,:),2); %2: First Difference
                elseif transformationindex(oo)==3
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(irf_estimates{oo,ll}(ii,:),2);    % 6: Second Difference
                elseif transformationindex(oo)==4
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(irf_estimates{oo,ll}(ii,:))-ones(ItBu,1);       %4: Log-Level
                elseif transformationindex(oo)==5
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(irf_estimates{oo,ll}(ii,:),2))-ones(ItBu,1); %5: Log-First-Difference
                elseif transformationindex(oo)==6
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(irf_estimates{oo,ll}(ii,:),2))-ones(ItBu,1); %6: Log-Second-Difference
                end
            end
        end
    end
elseif levels==3 % exp + cum sum + cum sum for second differences types
    for oo=1:n1 % variables
        for ll=1:n2 % shocks
            for ii=1:3 %for up.,median,low.
                if transformationindex(oo)==1 %1: no transformation, Level
                    retransformed_irf_estimates{oo,ll}(ii,:)=irf_estimates{oo,ll}(ii,:);
                elseif transformationindex(oo)==2
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(irf_estimates{oo,ll}(ii,:),2); %2: First Difference
                elseif transformationindex(oo)==3
                    retransformed_irf_estimates{oo,ll}(ii,:)=cumsum(cumsum(irf_estimates{oo,ll}(ii,:),2),2);    % 6: Second Difference
                elseif transformationindex(oo)==4
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(irf_estimates{oo,ll}(ii,:))-ones(ItBu,1);       %4: Log-Level
                elseif transformationindex(oo)==5
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(irf_estimates{oo,ll}(ii,:),2))-ones(ItBu,1); %5: Log-First-Difference
                elseif transformationindex(oo)==6
                    retransformed_irf_estimates{oo,ll}(ii,:)=exp(cumsum(cumsum(irf_estimates{oo,ll}(ii,:),2),2))-ones(ItBu,1); %6: Log-Second-Difference
                end
            end
        end
    end

else % do nothing, e.g. levels=0
    retransformed_irf_estimates=irf_estimates;
end


classdef dislocationSystem
% class representing dislocation
%
% Syntax
%   dS = dislocationSystem(b,l)
%   dS = dislocationSystem(sS)
%
% Input
%  b  - @Miller Burgers vector
%  l  - @Miller line vector
%  sS - @slipSystem
%  pr - poisson ratio
%
% Class Properties
%  b  - @Miller Burgers vector
%  l  - @Miller line vector
%  u  - energy
%  CS - @crystalSymmetry
%  isEdge  - is edge dislocation
%  isScrew - is screw dislocation
%
% See also
% DislocationSystems SlipSystems GND

  properties
    b % burgers vector
    l % line vector
    u % line energy of the dislocation system
  end

  properties (Dependent = true)
    CS
    isEdge
    isScrew
  end

  methods
    function dS = dislocationSystem(sS,l,u)

      if nargin == 0, return; end

      % adjust length burger vector edge dislocation a/2
      % for screw dislocations ??

      if isa(sS,'slipSystem')

        % define edge dislocations
        if sS.CS.lattice == 'hexagonal' %#ok<BDSCA>
          dS.b = 1/3 * sS.b;
        elseif sS.CS.lattice == 'cubic' %#ok<BDSCA>
          dS.b = 1/2 * sS.b;
        else
          dS.b = sS.b;
          warning('I could not determine the correct length of the Burgers vector. Please adjust it manually.')
        end
        dS.l = cross(sS.b,sS.n);

        % define screw dislocations
        b = 0.5*unique(sS.b,'antipodal','noSymmetry');
        dS.b = [dS.b(:);b(:)];
        dS.l = [dS.l(:);b(:)];

        % line energy
        dS.u = 1 + dS.isEdge;

      else

        b = sS;
        omega = angle(b,l,'noSymmetry');
        assert(all(omega > pi/2-1e-5 | omega<1e-5),...
          'line vector and burgers vector should be either be orthogonal! or identical')

        dS.b = sS;
        l.antipodal = true;
        dS.l = l;
        if nargin < 3, u = 1; end
        if numel(u) ~= length(dS.b), u = repmat(u,size(dS.b)); end
        dS.u = u;

      end

    end

    function CS = get.CS(sS)
      if isa(sS.b,'Miller')
        CS = sS.b.CS;
      else
        CS = specimenSymmetry;
      end
    end

    function isEdge = get.isEdge(dS)
      isEdge = angle(dS.b,dS.l,'noSymmetry') > pi/2 - 1e-5;
    end

    function isScrew = get.isScrew(dS)
      isScrew = angle(dS.b,dS.l,'noSymmetry') < 1e-5;
    end

    function display(dS,varargin)
      % standard output

      displayClass(dS,inputname(1),varargin{:});

      % display symmetry
      if isa(dS.CS,'crystalSymmetry')
        if ~isempty(dS.CS.mineral)
          disp([' mineral: ',char(dS.CS,'verbose')]);
        else
          disp([' symmetry: ',char(dS.CS,'verbose')]);
        end
      end

      toChar = @(x) char(round(x),'spaceSep');

      if any(dS.isEdge(:))

        disp([' edge dislocations : ',size2str(submatrix(ones(size(dS)),dS.isEdge))]);

        if isa(dS.CS,'crystalSymmetry')
          matrix = [arrayfun(toChar,dS.b(dS.isEdge),'UniformOutput',false),...
            arrayfun(toChar,dS.l(dS.isEdge),'UniformOutput',false),...
            vec2cell(dS.u(dS.isEdge))];

          cprintf(matrix,'-L',' ','-Lc',...
            {'Burgers vector' 'line vector' 'energy'},'-d','  ','-ic',true);
          disp(' ');

        end

      end

      if any(dS.isScrew(:))

        disp([' screw dislocations: ',size2str(submatrix(ones(size(dS)),dS.isScrew))]);

        if isa(dS.CS,'crystalSymmetry')
          matrix = [arrayfun(toChar,dS.l(dS.isScrew),'UniformOutput',false),...
            vec2cell(dS.u(dS.isScrew))];

          cprintf(matrix,'-L',' ','-Lc',...
            {'Burgers vector' 'energy'},'-d','  ','-ic',true);
          disp(' ');
        end
      end

    end

    function n = numArgumentsFromSubscript(varargin)
      n = 0;
    end

  end

  methods (Static = true)
    function dS = fcc(cs,varargin)
      dS = dislocationSystem(symmetrise(slipSystem.fcc(cs),'antipodal'));
    end

    function dS = bcc(cs,varargin)
      dS = dislocationSystem(symmetrise(slipSystem.bcc(cs),'antipodal'));
    end

    function dS = hcp(cs,varargin)
      dS = dislocationSystem(symmetrise(slipSystem.hcp(cs),'antipodal'));
    end

  end

end


%-------------------------------------------------------------------------------------------------------------------%
%
% IB2d is an Immersed Boundary Code (IB) for solving fully coupled non-linear
% 	fluid-structure interaction models. This version of the code is based off of
%	Peskin's Immersed Boundary Method Paper in Acta Numerica, 2002.
%
% Author: Nicholas A. Battista
% Email:  nick.battista@unc.edu
% Date Created: September 9th, 2016
% Institution: UNC-CH
%
% This code is capable of creating Lagrangian Structures using:
% 	1. Springs
% 	2. Beams (*torsional springs)
% 	3. Target Points
%	4. Muscle-Model (combined Force-Length-Velocity model, "HIll+(Length-Tension)")
%
% One is able to update those Lagrangian Structure parameters, e.g., spring constants, resting %%	lengths, etc
%
% There are a number of built in Examples, mostly used for teaching purposes.
%
% If you would like us %to add a specific muscle model, please let Nick (nick.battista@unc.edu) know.
%
%--------------------------------------------------------------------------------------------------------------------%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: creates the geometry and prints associated input files
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function Make_Your_Plates_and_Input_Files()

%
% Grid Parameters (MAKE SURE MATCHES IN input2d !!!)
%
Nx =  256;       % # of Eulerian Grid Pts. in x-Direction (MUST BE EVEN!!!)
Lx = 1.0;        % Length of Eulerian Grid in x-Direction
dx = Lx/Nx;      % Grid spatial resolution

%
% Immersed Structure Geometric / Dynamic Parameters %
%
ds = 0.5*dx;              % Lagrangian Pt. Spacing (2x resolution of Eulerian grid)
struct_name = 'plates';   % Name for .vertex, .spring, etc files. (must match what's in 'input2d')

% Call function to construct geometry
[xLag,yLag,dist] = give_Me_Immsersed_Boundary_Geometry(ds,Nx,Lx);

% Plot Geometry to test
plot(xLag,yLag,'r-'); hold on;
plot(xLag,yLag,'*'); hold on;
xlabel('x'); ylabel('y');
axis([0 Lx 0 Lx]);

% Prints .vertex file!
print_Lagrangian_Vertices(xLag,yLag,struct_name);

% Prints .spring file!
k_Spring = 2.5e4;                    % Spring stiffness (does not need to be equal for all springs)
ds_Plates = dist;                    % Spring resting length (does not need to be equal for all springs)
print_Lagrangian_Springs(xLag,yLag,k_Spring,ds_Plates,ds,struct_name);

% Prints .beam file!
% k_Beam = 0.5;                      % Beam Stiffness (does not need to be equal for all beams)
% C = compute_Curvatures(xLag,yLag)  % Computes curvature of initial configuration
%print_Lagrangian_Beams(xLag,yLag,k_Beam,C,struct_name);

% Prints .target file!
%k_Target = 1e7;
%print_Lagrangian_Target_Pts(xLag,k_Target,struct_name);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints VERTEX points to a file called 'struct_name'.vertex
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Vertices(xLag,yLag,struct_name)

    N = length(xLag); % Total # of Lag. Pts

    vertex_fid = fopen([struct_name '.vertex'], 'w');

    fprintf(vertex_fid, '%d\n', N );

    %Loops over all Lagrangian Pts.
    for s = 1:N
        X_v = xLag(s);
        Y_v = yLag(s);
        fprintf(vertex_fid, '%1.16e %1.16e\n', X_v, Y_v);
    end

    fclose(vertex_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints SPRING points to a file called 'struct_name'.spring
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Springs(xLag,yLag,k_Spring,ds_Plates,ds,struct_name)

    N = length(xLag);

    spring_fid = fopen([struct_name '.spring'], 'w');

    fprintf(spring_fid, '%d\n', N-2 + N/2 );    % Print # of springs

    %SPRINGS BETWEEN VERTICES
    for s = 1:N
            if s < N/2
                fprintf(spring_fid, '%d %d %1.16e %1.16e\n', s, s+1, k_Spring, ds);
            elseif s > N/2
                fprintf(spring_fid, '%d %d %1.16e %1.16e\n', s, s+1, k_Spring, ds);
            end
    end

    % SPRINGS ACROSS PLATES
    for s=1:N/2
        fprintf(spring_fid, '%d %d %1.16e %1.16e\n', s, s+N/2, k_Spring, ds_Plates);
    end

    fclose(spring_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints TARGET points to a file called 'struct_name'.vertex
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Target_Pts(xLag,k_Target,struct_name)

    N = length(xLag);

    target_fid = fopen([struct_name '.target'], 'w');

    fprintf(target_fid, '%d\n', N );

    %Loops over all Lagrangian Pts.
    for s = 1:N
        fprintf(target_fid, '%d %1.16e\n', s, k_Target);
    end

    fclose(target_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: prints BEAM (Torsional Spring) points to a file called 'struct_name'.beam
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function print_Lagrangian_Beams(xLag,yLag,k_Beam,C,struct_name)

    % k_Beam: beam stiffness
    % C: beam curvature

    N = length(xLag); % NOTE: Total number of beams = Number of Total Lag Pts. - 2

    beam_fid = fopen([struct_name '.beam'], 'w');

    fprintf(beam_fid, '%d\n', N );

    %spring_force = kappa_spring*ds/(ds^2);

    %BEAMS BETWEEN VERTICES
    for s = 2:N-1
            if  s <= N-1
                fprintf(beam_fid, '%d %d %d %1.16e %1.16e\n',s-1, s, s+1, k_Beam, C(s) );
            else
                %Case s=N
                fprintf(beam_fid, '%d %d %d %1.16e %1.16e\n',s-1, s, 1,   k_Beam, C(s) );
            end
    end
    fclose(beam_fid);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: computes "curvature" of starting configuration
%
% NOTE: not curvature in the traditional geometric sense, in the 'discrete'
% sense through cross product.
%
% NOTE: assumes a CLOSED structure
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function C = compute_Curvatures(xLag,yLag)

N = length(xLag);
C = zeros( N );

%Note: needs to be done same order as you print .beam file!
for i=1:N

   % Pts Xp -> Xq -> Xr (same as beam force calc.)

   if ( (i > 1) && (i < N) )

        Xp = xLag(i-1); Xq = xLag(i); Xr = xLag(i+1);
        Yp = yLag(i-1); Yq = yLag(i); Yr = yLag(i+1);

   elseif (i==1)

        Xp = xLag(N); Xq = xLag(i); Xr = xLag(i+1);
        Yp = yLag(N); Yq = yLag(i); Yr = yLag(i+1);

   elseif (i==N)

        Xp = xLag(N-1); Xq = xLag(N); Xr = xLag(1);
        Yp = yLag(N-1); Yq = yLag(N); Yr = yLag(1);

   end

   C(i) = (Xr-Xq)*(Yq-Yp) - (Yr-Yq)*(Xq-Xp); %Cross product btwn vectors

end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: creates the Lagrangian structure geometry
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function [xLag,yLag,dist] = give_Me_Immsersed_Boundary_Geometry(ds,Nx,L)

% ds: Lagrangian pt. spacing
% Nx: Eulerian grid resolution
% L:  Length of computational domain

yLag = 0:ds:L/5;             % Make plate of length L/10
xLag = zeros(1,length(yLag)); % Make corresponding xPts for Vertical Plate

% Translate points
yLag = yLag + (L/2-L/10);  % Translate them symmetrically

% Make sides
xLag_Left = xLag + (L/2-L/10);
xLag_Right = xLag + (L/2+L/10);

% Combine Pts Into ONE Vector
xLag = [xLag_Left xLag_Right];
yLag = [yLag yLag];

% Distance between plates
dist = (L/2+L/10) - (L/2-L/10);

% Plot the Geometry
% plot(xLag,yLag,'*'); hold on;
% axis([0 L 0 L]);


function p05_title ( )

%*****************************************************************************80
%
%% P05_TITLE prints a title for problem 05.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 March 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    None
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'Problem 05\n' );
  fprintf ( 1, '  Name:       ST04\n' );
  fprintf ( 1, '              Stroud #4, page 26.\n' );
  fprintf ( 1, '  Region:     0 <= X(i) <= 1\n' );
  fprintf ( 1, '  Integrand:  F(X) = 1 / ( 1 + sum ( 2 * X(i) ) )\n' );

  return
end


function PlotAdaptiveContour3D(u, levels, tol)

% function PlotAdaptiveContour3D(u, levels, tol)
% Purpose: adaptively refine the mesh to approximately locate isocontours

Globals3D;

% build interpolation matrix (coarse->fine)
EToVi = [1 5 7 8; 5 2 6 9; 7 6 3 10; 8 9 10 4; 8 5 7 9; 7 5 6 9; 8 9 7 10; 9 6 7 10];
VXi   = [-1  1 -1 -1  0  0 -1 -1  0 -1];
VYi   = [-1 -1  1 -1 -1  0  0 -1 -1  0];
VZi   = [-1 -1 -1  1 -1 -1 -1  0  0  0];

v1 = EToVi(:,1); v2 = EToVi(:,2); v3 = EToVi(:,3); v4 = EToVi(:,4);
ri = 0.5*(-(r+s+t+1)*VXi(v1) + (1+r)*VXi(v2) + (1+s)*VXi(v3) + (1+t)*VXi(v4) );
si = 0.5*(-(r+s+t+1)*VYi(v1) + (1+r)*VYi(v2) + (1+s)*VYi(v3) + (1+t)*VYi(v4) );
ti = 0.5*(-(r+s+t+1)*VZi(v1) + (1+r)*VZi(v2) + (1+s)*VZi(v3) + (1+t)*VZi(v4) );

interp = Vandermonde3D(N, ri(:), si(:), ti(:))*invV;
ri = [-1;1;-1;-1]; si = [-1;-1;1;-1]; ti = [-1;-1;-1;1]; refNp = length(ri);
interp1 = Vandermonde3D(N, ri(:), si(:), ti(:))*invV;

Nlevels = length(levels);

sk = 1;
F = spalloc(Np,Np,1);
for i=0:N % old ordering
  for j=0:N - i
    for k=0:N - i - j
      if(i+j+k<=1), F(sk,sk) = 1.; end;
      sk = sk+1;
    end
  end
end

hold on;
for n=1:Nlevels

  xref = x; yref = y; zref = z; uref = u; Kref = K; Jref = J;

  err = 1;
  while(err > tol)

    level = levels(n);

    umin = min(uref, [], 1);
    umax = max(uref, [], 1);

    refineflag = (umin <= level & umax >= level);

    toref = find( refineflag);
    Nref = length(toref);

    uref = reshape(interp*uref(:,toref), Np, 8*Nref);
    xref = reshape(interp*xref(:,toref), Np, 8*Nref);
    yref = reshape(interp*yref(:,toref), Np, 8*Nref);
    zref = reshape(interp*zref(:,toref), Np, 8*Nref);
    Jref = reshape(interp*Jref(:,toref), Np, 8*Nref)/8;

    Kref = 8*Nref;

    ufilt = V*(F*(invV*uref));
    err = max(max(abs(ufilt-uref)));

  end

  xref = interp1*xref; yref = interp1*yref; zref = interp1*zref; uref = interp1*uref;

  tets = reshape(1:4*Kref, 4, Kref)';

  x1 = xref(1,:)'; y1 = yref(1,:)'; z1 = zref(1,:)'; u1 = uref(1,:)' + 1e-10*rand(Kref,1);
  x2 = xref(2,:)'; y2 = yref(2,:)'; z2 = zref(2,:)'; u2 = uref(2,:)' + 1e-10*rand(Kref,1);
  x3 = xref(3,:)'; y3 = yref(3,:)'; z3 = zref(3,:)'; u3 = uref(3,:)' + 1e-10*rand(Kref,1);
  x4 = xref(4,:)'; y4 = yref(4,:)'; z4 = zref(4,:)'; u4 = uref(4,:)' + 1e-10*rand(Kref,1);

  trix = []; triy = []; triz = []; triu = [];;

  umin = min(uref, [], 1);
  umax = max(uref, [], 1);

  lev = levels(n);

  % find candidate elements
  ks = find(umin<= lev & umax >= lev);

  Nks = length(ks);

  if(Nks>0)

    fc = zeros(Nks,6);

    u1ks = u1(ks); u2ks = u2(ks); u3ks = u3(ks); u4ks = u4(ks);

    % find local coordinate at each of 6 edges
    c1 = (lev-u1ks)./(u2ks-u1ks);  fc(:,1) = (c1>=0 & c1<=1);
    c2 = (lev-u2ks)./(u3ks-u2ks);  fc(:,2) = (c2>=0 & c2<=1);
    c3 = (lev-u3ks)./(u1ks-u3ks);  fc(:,3) = (c3>=0 & c3<=1);
    c4 = (lev-u1ks)./(u4ks-u1ks);  fc(:,4) = (c4>=0 & c4<=1);
    c5 = (lev-u2ks)./(u4ks-u2ks);  fc(:,5) = (c5>=0 & c5<=1);
    c6 = (lev-u3ks)./(u4ks-u3ks);  fc(:,6) = (c6>=0 & c6<=1);

    % find triangle intersection
    tris = find(sum(fc, 2)==3); Ntris = length(tris);  tfc = fc(tris,:); ids = find(tfc');
    ktris = ks(tris);

    % trim list
    tc1 = c1(tris); tc2 = c2(tris); tc3 = c3(tris); tc4 = c4(tris); tc5 = c5(tris); tc6 = c6(tris);

    tx1 = x1(ktris);   ty1 = y1(ktris);   tz1 = z1(ktris);
    tx2 = x2(ktris);   ty2 = y2(ktris);   tz2 = z2(ktris);
    tx3 = x3(ktris);   ty3 = y3(ktris);   tz3 = z3(ktris);
    tx4 = x4(ktris);   ty4 = y4(ktris);   tz4 = z4(ktris);

    xc = zeros(Ntris, 6); yc = zeros(Ntris, 6); zc = zeros(Ntris, 6);
    xc(:,1) = (1-tc1).*tx1 + tc1.*tx2; yc(:,1) = (1-tc1).*ty1 + tc1.*ty2; zc(:,1) = (1-tc1).*tz1 + tc1.*tz2;
    xc(:,2) = (1-tc2).*tx2 + tc2.*tx3; yc(:,2) = (1-tc2).*ty2 + tc2.*ty3; zc(:,2) = (1-tc2).*tz2 + tc2.*tz3;
    xc(:,3) = (1-tc3).*tx3 + tc3.*tx1; yc(:,3) = (1-tc3).*ty3 + tc3.*ty1; zc(:,3) = (1-tc3).*tz3 + tc3.*tz1;
    xc(:,4) = (1-tc4).*tx1 + tc4.*tx4; yc(:,4) = (1-tc4).*ty1 + tc4.*ty4; zc(:,4) = (1-tc4).*tz1 + tc4.*tz4;
    xc(:,5) = (1-tc5).*tx2 + tc5.*tx4; yc(:,5) = (1-tc5).*ty2 + tc5.*ty4; zc(:,5) = (1-tc5).*tz2 + tc5.*tz4;
    xc(:,6) = (1-tc6).*tx3 + tc6.*tx4; yc(:,6) = (1-tc6).*ty3 + tc6.*ty4; zc(:,6) = (1-tc6).*tz3 + tc6.*tz4;
    xc = xc'; yc = yc'; zc = zc';

    ids = reshape(ids, 3, Ntris);

    trix = [trix, xc(ids)];
    triy = [triy, yc(ids)];
    triz = [triz, zc(ids)];
    triu = [triu, lev*ones(size(ids))];

    % find quadrilateral intersection
    quads = find(sum(fc, 2)==4); Nquads = length(quads);  qfc = fc(quads,:); ids = find(qfc');
    kquads = ks(quads);

    % quad list
    qc1 = c1(quads); qc2 = c2(quads); qc3 = c3(quads); qc4 = c4(quads); qc5 = c5(quads); qc6 = c6(quads);

    qx1 = x1(kquads);   qy1 = y1(kquads);   qz1 = z1(kquads);
    qx2 = x2(kquads);   qy2 = y2(kquads);   qz2 = z2(kquads);
    qx3 = x3(kquads);   qy3 = y3(kquads);   qz3 = z3(kquads);
    qx4 = x4(kquads);   qy4 = y4(kquads);   qz4 = z4(kquads);

    xc = zeros(Nquads, 6); yc = zeros(Nquads, 6); zc = zeros(Nquads, 6);
    xc(:,1) = (1-qc1).*qx1 + qc1.*qx2; yc(:,1) = (1-qc1).*qy1 + qc1.*qy2; zc(:,1) = (1-qc1).*qz1 + qc1.*qz2;
    xc(:,2) = (1-qc2).*qx2 + qc2.*qx3; yc(:,2) = (1-qc2).*qy2 + qc2.*qy3; zc(:,2) = (1-qc2).*qz2 + qc2.*qz3;
    xc(:,3) = (1-qc3).*qx3 + qc3.*qx1; yc(:,3) = (1-qc3).*qy3 + qc3.*qy1; zc(:,3) = (1-qc3).*qz3 + qc3.*qz1;
    xc(:,4) = (1-qc4).*qx1 + qc4.*qx4; yc(:,4) = (1-qc4).*qy1 + qc4.*qy4; zc(:,4) = (1-qc4).*qz1 + qc4.*qz4;
    xc(:,5) = (1-qc5).*qx2 + qc5.*qx4; yc(:,5) = (1-qc5).*qy2 + qc5.*qy4; zc(:,5) = (1-qc5).*qz2 + qc5.*qz4;
    xc(:,6) = (1-qc6).*qx3 + qc6.*qx4; yc(:,6) = (1-qc6).*qy3 + qc6.*qy4; zc(:,6) = (1-qc6).*qz3 + qc6.*qz4;
    xc = xc'; yc = yc'; zc = zc';

    ids1 = reshape(ids, 4, Nquads);
    ids2 = ids1([1;4;2;3],:);
    ids3 = ids1([1;3;4;2],:);

    % find length perimeters bounded by 4 nodes
    perims1 = QuadPerimeter3D(xc(ids1),yc(ids1),zc(ids1));
    perims2 = QuadPerimeter3D(xc(ids2),yc(ids2),zc(ids2));
    perims3 = QuadPerimeter3D(xc(ids3),yc(ids3),zc(ids3));

    % locate minimum perimeter quad
    idsA = find(perims1<min(perims2, perims3));
    idsB = find(perims2<min(perims1, perims3));
    idsC = find(perims3<min(perims1, perims2));

    % use only minimum perimeter quads
    ids  = [ids1(:,idsA),ids2(:,idsB),ids3(:,idsC)];

    % divide into two triangles (ok since quad must be convex)
    ids1 = [ids([1;2;3],:),ids([1;3;4],:)];

    % add triangles to list
    trix = [trix, xc(ids1)];
    triy = [triy, yc(ids1)];
    triz = [triz, zc(ids1)];
    triu = [triu, lev*ones(size(ids1))];

  end

  size(trix)

  ha = patch(trix,triy,triz,triu); shading interp;

  set(ha, 'EdgeColor', 'none')
end
hold off;

camlight; material shiny; lighting gouraud; view(3); axis equal;
axis off;

return;


% Calculate border coverage for detected fields
%
% This function calculates firing map border coverage that is further
% used in calculation of a border score.
%
%  USAGE
%   coverage = analyses.borderCoverage(fields, <options>)
%   fields          Array of structures with information about detected fields.
%   <options>       Optional list of property-value pairs (see table below)
%
%   ==============================================================================================
%    Properties    Values
%   ----------------------------------------------------------------------------------------------
%    'searchWidth'  If map is not perfect, but contains NaN values along borders, then
%                   search for border pixels can have NaNs. To mitigate this, we check
%                   searchWidth rows/columns near border and if the closest to the border pixel
%                   equals to NaN, we search for first non-NaN value in searchWidth rows-columns.
%                   This argument is optional and default value is 8.
%    'walls'        Definition of walls along which the border score is calculated. Provided by
%                   a string which contains characters that stand for walls:
%                   T - top wall (we assume the bird-eye view on the arena)
%                   R - right wall
%                   B - bottom wall
%                   L - left wall
%                   Characters are case insensitive. Default value is 'TRBL' meaning that border
%                   score is calculated along all walls. Any combination is possible, e.g.
%                   'R' to calculate along right wall, 'BL' to calculate along two walls, e.t.c.
%   ==============================================================================================
%   coverage        Border coverage, ranges from 0 to 1.
%
function coverage = borderCoverage(fields, varargin)
    coverage = 0;

    inp = inputParser;
    defaultSearchWidth = 8;
    defaultWalls = 'TRBL'; % top, right, bottom, left

    checkSearchWidth = @(x) isnumeric(x) && isscalar(x) && (x > 0);
    checkWalls = @internCheckWalls;

    addRequired(inp, 'fields');
    addParameter(inp, 'searchWidth', defaultSearchWidth, checkSearchWidth);
    addParameter(inp, 'walls', defaultWalls, checkWalls);

    inp.KeepUnmatched = true;
    parse(inp, fields, varargin{:});

    % get parsed results
    walls = inp.Results.walls;
    searchWidth = inp.Results.searchWidth;

    % find out what walls are present
    dict = {'B', 'L', 'R', 'T'}; % already sorted
    u = unique(walls);
    t = ['^' sprintf('%c{0,%d}', [u; histc(walls, u)]) '$'];
    wallsIdx = find(~cellfun('isempty', regexpi(dict, t))); % indices in dict of present walls

    for i=1:length(fields)
        curField = fields(i).map;

        % coverage for left wall
        if any(ismember(wallsIdx, 2))
            aux_map = curField(:, 1:searchWidth);
            [covered, norm] = wall_field(aux_map);
            if (covered/norm > coverage)
                coverage = covered/norm;
            end
        end

        % coverage for right wall
        if any(ismember(wallsIdx, 3))
            aux_map = curField(:, end:-1:end+1-searchWidth);
            [covered, norm] = wall_field(aux_map);
            if (covered/norm > coverage)
                coverage=covered/norm;
            end
        end

        % coverage for bottom wall, since we are dealing with data that came from a camera
        % 'bottom' is actually at the top of the matrix curField.
        if (any(ismember(wallsIdx, 1)))
            aux_map = curField(1:searchWidth, :)';
            [covered, norm] = wall_field(aux_map);
            if (covered/norm > coverage)
                coverage=covered/norm;
            end
        end

        % coverage for top wall
        if (any(ismember(wallsIdx, 4)))
            aux_map = curField(end:-1:end+1-searchWidth, :)';
            [covered, norm] = wall_field(aux_map);
            if (covered/norm > coverage)
                coverage = covered/norm;
            end
        end
    end
end

% 'covered' pixels will have distance to border 0.
% Essentially we need to calculate number of elements,
% that equal to zero and take NaNs into account.
function [covered, norm] = wall_field(map)
    ly = size(map, 1);

    D = bwdist(map);
    nanIndices = find(isnan(map(:, 1)));
    numNans = length(nanIndices);
    for i = 1:numNans
        testRow = nanIndices(i);
        nonNan = find(~isnan(map(testRow, :)), 1, 'first');
        if ~isempty(nonNan)
            numNans = numNans - 1;
            D(testRow, 1) = D(testRow, nonNan);
        end
    end

    norm = ly - numNans;
    covered = nansum(D(:, 1) == 0) - numNans;
end

% check input argument that defines walls
% We need to figure out if argument contains one of the characters
% from the dictionary.
% Rise descriptive exception in case of an error.
function res = internCheckWalls(walls)
    res = true;
    if ~ischar(walls)
        error('BNT:args:notChar', 'Argument is not a string.')
    end
    if length(walls) > 4
        error('BNT:args:length', 'Argument can not exceed 4 characters (default ''TLBR'')');
    end

    dict = {'T', 'R', 'B', 'L'};

    % http://stackoverflow.com/questions/19343339/matlab-find-the-indices-of-a-cell-array-of-strings-with-characters-all-containe
    u = unique(walls);
    t = ['^' sprintf('%c{0,%d}', [u; histc(walls, u)]) '$'];
    s = cellfun(@sort, dict, 'uni', 0);
    idx = find(~cellfun('isempty', regexp(s, t)), 1);
    %res = ~isempty(idx); % if it is not empty, then we have characters from dict in walls
    if isempty(idx)
        error('BNT:args:noValidChars', 'There is no information about the walls in the argument.');
    end
end


function z = plus( x, y )
    %PLUS Addition of two TT/MPS tensors.
    %   Z = PLUS(X,Y) adds two TT/MPS tensors. The rank of the resulting
    %   tensor is 2*R.
    %
    %   See also MINUS, UMINUS.

    %   TTeMPS Toolbox.
    %   Michael Steinlechner, 2013-2016
    %   Questions and contact: michael.steinlechner@epfl.ch
    %   BSD 2-clause license, see LICENSE.txt

    % add sanity check...
    rx = x.rank;
    ry = y.rank;
    nx = x.size;

    z = TTeMPS( cell(1, x.order) );

    % first core:
    p = size(x.U{1},4);
    tmp = zeros( 1, nx(1), rx(2)+ry(2), p );
    tmp( 1, :, 1:rx(2), : ) = x.U{1};
    tmp( 1, :, rx(2)+1:end, : ) = y.U{1};
    z.U{1} = tmp;

    % central cores:
    for i = 2:x.order-1
        % possibility of block format:
        p = size(x.U{i},4);
        tmp = zeros( rx(i)+ry(i), nx(i), rx(i+1)+ry(i+1), p);
        tmp( 1:rx(i), :, 1:rx(i+1), :) = x.U{i};
        tmp( rx(i)+1:end, :, rx(i+1)+1:end, :) = y.U{i};
        z.U{i} = tmp;
    end

    % last core:
    p = size(x.U{end},4);
    tmp = zeros( rx(end-1)+ry(end-1), nx(end), 1, p );
    tmp( 1:rx(end-1), :, 1, : ) = x.U{end};
    tmp( rx(end-1)+1:end, :, 1, : ) = y.U{end};
    z.U{end} = tmp;
end


function stats = ReconstructPosition(positions,spikes,phases,varargin)

%ReconstructPosition - Bayesian reconstruction of positions from spike trains.
%
% Instantaneous positions are reconstructed using a Bayesian algorithm.
% Instantaneous population firing rates can be estimated either over fixed time
% windows, or over fractions of the theta cycle (or of any other brain rhythm).
% Similarly, positions will be reconstructed either over time or phase windows.
% The model is first trained on a subset of the data, then tested on the rest.
%
% USAGE
%
%    stats = ReconstructPosition(positions,spikes,phases,<options>)
%
%    positions      linear or two-dimensional positions, in [0..1]
%    spikes         list of (t,group,cluster) triplets (obtained via e.g.
%                   GetSpikes, using full output)
%    phases         optional unwrapped phase of the LFP (see Phase)
%
%    =========================================================================
%     Properties    Values
%    -------------------------------------------------------------------------
%     'training'    time interval over which the model should be trained
%                   (default = first half of the position data)
%     'window'      length of the time or phase window (default = 0.020 s for
%                   time, and pi/3 for phases)
%     'type'        two letters (one for X and one for Y) indicating which
%                   coordinates are linear ('l') and which are circular ('c')
%                   - for 1D data, only one letter is used (default 'll')
%     'nBins'       firing curve or map resolution (default = [200 200])
%    =========================================================================
%
%   OUTPUT
%
%     stats.positions     real position across time or phase windows
%     stats.spikes        cell firing vector across time or phase windows
%     stats.estimations   estimated position across time or phase windows
%     stats.errors        estimation error across time or phase windows
%     stats.average       average estimation error in each phase window
%     stats.windows       time windows (possibly computed from phases)
%     stats.phases        phase windows (empty for fixed time windows)
%

% Copyright (C) 2012-2013 by Michaël Zugaro, (C) 2012 by Karim El Kanbi
%
% 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.

% Defaults
wt = 0.020; % default time window
wp = pi/3; % default phase window
window = [];
nBins = 200;
training = 0.5;
type = '';
nDimensions = 1;

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

% Optional parameter 'phases'
if nargin == 2,
	phases = [];
elseif nargin >= 3 && ischar(phases),
	varargin = {phases,varargin{:}};
	phases = [];
end

% Check parameter sizes
if ~isdmatrix(positions),
	builtin('error','Incorrect positions (type ''help ReconstructPosition'' for details).');
end
if ~isdmatrix(spikes),
	builtin('error','Incorrect spikes (type ''help ReconstructPosition'' for details).');
end
if size(positions,2) > 3,
	nDimensions = 2;
end
if ~isempty(phases) && ~isdmatrix(phases),
	builtin('error','Incorrect value for property ''phases'' (type ''help ReconstructPosition'' for details).');
end

% Check number of output parameters
if isempty(phases) && nargout == 3,
	builtin('error','Too many output parameters or missing phases (type ''help ReconstructPosition'' for details).');
end

% Parse parameters
for i = 1:2:length(varargin),
	if ~ischar(varargin{i}),
		builtin('error',['Parameter ' num2str(i+2) ' is not a property (type ''help ReconstructPosition'' for details).']);
	end
	switch(lower(varargin{i})),
		case 'training',
			training = varargin{i+1};
			if ~isdvector(training,'>'),
				builtin('error','Incorrect value for property ''training'' (type ''help ReconstructPosition'' for details).');
			end
		case 'window',
			window = varargin{i+1};
			if ~isdscalar(window,'>0'),
				builtin('error','Incorrect value for property ''window'' (type ''help ReconstructPosition'' for details).');
			end
		case 'show',
			show = varargin{i+1};
			if ~isstring_FMAT(show,'on','off'),
				builtin('error','Incorrect value for property ''show'' (type ''help ReconstructPosition'' for details).');
			end
		case 'nBins',
			nBins = varargin{i+1};
			if ~isinteger(nBins),
				builtin('error','Incorrect value for property ''nBins'' (type ''help ReconstructPosition'' for details).');
			end
		case 'type',
			type = lower(varargin{i+1});
			if (nDimensions == 1 && ~isstring_FMAT(type,'cc','cl','lc','ll')) || (nDimensions == 2 && ~isstring_FMAT(type,'ccl','cll','lcl','lll','ccc','clc','lcc','llc')),
				builtin('error','Incorrect value for property ''type'' (type ''help ReconstructPosition'' for details).');
			end
		otherwise,
			builtin('error',['Unknown property ''' num2str(varargin{i}) ''' (type ''help ReconstructPosition'' for details).']);
	end
end

% Defaults
if isempty(window),
	if isempty(phases),
		window = wt;
	else
		window = wp;
		if ~isiscalar((2*pi)/window),
			builtin('error',['Incorrect phase window: not an integer fraction of 2pi (type ''help ReconstructPosition'' for details).']);
		end
	end
end
if isdscalar(training),
	training = [-Inf positions(1,1)+training*(positions(end,1)-positions(1,1))];
else
	if min([positions(1,1) spikes(1,1)]) < training(1) & min([positions(end,1) spikes(end,1)]) > training(2),
		builtin('error',['Spikes or positions occur both before and after training interval (type ''help ReconstructPosition'' for details).']);
	end
end
if isempty(type),
	if nDimensions == 2,
		type = 'lll';
	else
		type = 'll';
	end
end
nBinsX = nBins(1);
if length(nBins) > 2,
	nBinsY = nBins(2);
else
	if nDimensions == 2,
		nBinsY = nBinsX;
	else
		nBinsY = 1;
	end
end

% List units, assign them an ID (number them from 1 to N), and associate these IDs with each spike
% (IDs will be easier to manipulate than (group,cluster) pairs in subsequent computations)
[units,~,i] = unique(spikes(:,2:end),'rows');
nUnits = length(units);
index = 1:nUnits;
id = index(i)';
spikes = [spikes(:,1) id];

% Split data (training vs test)
trainingPositions = Restrict(positions,training);
trainingSpikes = Restrict(spikes,training);
testPositions = positions(~InIntervals(positions,training),:);
testSpikes = spikes(~InIntervals(spikes,training),:);

% TRAINING

% Compute occupancy probability P(x) (i.e. normalized occupancy map)
firstUnit = trainingSpikes(:,2) == 1;
s = trainingSpikes(firstUnit,1);
map = Map(trainingPositions,s,'nbins',nBins,'smooth',5,'type',type);
Px = map.time;
Px = Px ./ sum(Px(:));

% Compute average firing probability lambda for each unit (i.e. firing maps)
lambda(:,:,1) = map.z;
for i = 2:nUnits,
	nextUnit = trainingSpikes(:,2) == i;
	s = trainingSpikes(nextUnit,1);
	map = Map(trainingPositions,s,'nbins',nBins,'smooth',5,'type',type);
	lambda(:,:,i) = map.z;
end

% TEST

% Determine time windows (using unwrapped phases if necessary)
if ~isempty(phases),
	testPhases = phases(~InIntervals(phases,training),:);
	drop = testPhases(:,1) < testPositions(1,1);
	testPhases(drop,:) = [];
	startPhase = ceil(testPhases(1,2)/(2*pi))*2*pi;
	stopPhase = floor(testPhases(end,2)/(2*pi))*2*pi;
	windows = (startPhase:window:stopPhase)';
	stats.phases = windows;
	windows = Interpolate(testPhases(:,[2 1]),windows);
	windows = [windows(1:end-1,2) windows(2:end,2)];
else
	stats.phases = [];
	windows = (testPositions(1,1):window:testPositions(end,1))';
	windows = [windows(1:end-1) windows(2:end)];
end
nWindows = size(windows,1);

stats.estimations = nan(nBinsY,nBinsX,nWindows);
stats.spikes = zeros(nUnits,nWindows);
% Loop over data windows
for i = 1:nWindows,

	% Get spikes for this window
	s = Restrict(testSpikes,windows(i,:));

	if isempty(s),
		% No spikes: set uniform probability
		stats.estimations(:,:,i) = ones(nBinsY,nBinsX,1)/(nBinsX*nBinsY);
		continue;
	end

	% Population spike count vector
	stats.spikes(:,i) = Accumulate(s(:,2),1,nUnits);
	% To avoid 'for' loops, prepare for vector computation:
	% assign a spike count to each position and unit (3D array)
	n = reshape(repmat(stats.spikes(:,i),1,nBinsX*nBinsY)',nBinsY,nBinsX,nUnits);

	% For each cell i, compute P(ni|x) using a Poisson model
	dt = windows(i,2) - windows(i,1);
	Pnix = (dt*lambda).^n./factorial(n).*exp(-dt*lambda);
	% Compute P(n|x) assuming independent probabilities across units (hmm...)
	% i.e. P(n|x) = product over i of P(ni|x)
	Pnx = prod(Pnix,3);

	% Compute P(n) = sum over x of P(n|x)*P(x)
	Pn = sum(sum(Pnx.*Px));

	% Compute P(x|n) = P(n|x)*P(x)/P(n)
	Pxn = Pnx .* Px / Pn;

	% Store result
	stats.estimations(:,:,i) = Pxn;

end
stats.estimations = squeeze(stats.estimations);
stats.windows = windows;

% Estimation error

stats.errors = [];
stats.average = [];
if nDimensions == 1,
	% Bin test positions and compute distance to center
	stats.positions = Interpolate(testPositions,windows(:,1));
	stats.positions(:,2) = Bin(stats.positions(:,2),[0 1],nBinsX);
	dx = (round(nBinsX/2)-stats.positions(:,2))';
	% Shift estimated position by the real distance to center
	stats.errors = CircularShift(stats.estimations(:,1:length(dx)),dx);
	% Average over one or more cycles
	k = 2*pi/window;
	n = floor(size(stats.errors,2)/k)*k;
	stats.average = reshape(stats.errors(:,1:n),nBins,k,[]);
	stats.average = nanmean(stats.average,3);
else
	warning('Computation of estimation error not yet implemented for 2D environments');
end


function [D, optinf] = ccmod(X, S, dsz, opt)

% ccmod -- Convolutional Constrained Method of Optimal Directions (MOD)
%
%         argmin_{d_m} (1/2) \sum_k ||\sum_m x_k,m * d_m - s_k||_2^2
%                      such that ||d_m||_2 = 1
%
%         The solution of the Convolutional Constrained MOD problem
%         (see wohlberg-2016-efficient) is computed using the ADMM
%         approach (see boyd-2010-distributed).
%
% Usage:
%       [D, optinf] = ccmod(X, S, dsz, opt)
%
% Input:
%       X           Coefficient maps (3D array)
%       S           Input images
%       dsz         Dictionary size
%       opt         Algorithm parameters structure
%
% Output:
%       D           Dictionary filter set (3D array)
%       optinf      Details of optimisation
%
%
% Options structure fields:
%   Verbose           Flag determining whether iteration status is displayed.
%                     Fields are iteration number, functional value,
%                     data fidelity term, l1 regularisation term, and
%                     primal and dual residuals (see Sec. 3.3 of
%                     boyd-2010-distributed). The values of rho and sigma
%                     are also displayed if options request that they are
%                     automatically adjusted.
%   MaxMainIter       Maximum main iterations
%   AbsStopTol        Absolute convergence tolerance (see Sec. 3.3.1 of
%                     boyd-2010-distributed)
%   RelStopTol        Relative convergence tolerance (see Sec. 3.3.1 of
%                     boyd-2010-distributed)
%   G0                Initial value for G
%   H0                Initial value for H
%   sigma             ADMM penalty parameter
%   AutoSigma         Flag determining whether sigma is automatically updated
%                     (see Sec. 3.4.1 of boyd-2010-distributed)
%   AutoSigmaPeriod   Iteration period on which sigma is updated
%   SigmaRsdlRatio    Primal/dual residual ratio in sigma update test
%   SigmaScaling      Multiplier applied to sigma when updated
%   AutoSigmaScaling  Flag determining whether SigmaScaling value is
%                     adaptively determined (see wohlberg-2015-adaptive). If
%                     enabled, SigmaScaling specifies a maximum allowed
%                     multiplier instead of a fixed multiplier.
%   StdResiduals      Flag determining whether standard residual definitions
%                     (see Sec 3.3 of boyd-2010-distributed) are used instead
%                     of normalised residuals (see wohlberg-2015-adaptive)
%   RelaxParam        Relaxation parameter (see Sec. 3.4.3 of
%                     boyd-2010-distributed)
%   LinSolve          Linear solver for main problem: 'SM' or 'CG'
%   MaxCGIter         Maximum CG iterations when using CG solver
%   CGTol             CG tolerance when using CG solver
%   CGTolAuto         Flag determining use of automatic CG tolerance
%   CGTolFactor       Factor by which primal residual is divided to obtain CG
%                     tolerance, when automatic tolerance is active
%   ZeroMean          Force learned dictionary entries to be zero-mean
%   AuxVarObj         Flag determining whether objective function is computed
%                     using the auxiliary (split) variable
%
%
% Author: Brendt Wohlberg <brendt@lanl.gov>  Modified: 2015-12-18
%
% This file is part of the SPORCO library. Details of the copyright
% and user license can be found in the 'License' file distributed with
% the library.

if nargin < 4,
  opt = [];
end
checkopt(opt, defaultopts([]));
opt = defaultopts(opt);

% Set up status display for verbose operation
hstr = 'Itn   Obj       Cnst      r         s      ';
sfms = '%4d %9.2e %9.2e %9.2e %9.2e';
nsep = 44;
if opt.AutoSigma,
  hstr = [hstr '   sigma  '];
  sfms = [sfms ' %9.2e'];
  nsep = nsep + 10;
end
if opt.Verbose && opt.MaxMainIter > 0,
  disp(hstr);
  disp(char('-' * ones(1,nsep)));
end

% Collapsing of trailing singleton dimensions greatly complicates
% handling of both SMV and MMV cases. The simplest approach would be
% if S could always be reshaped to 4d, with dimensions consisting of
% image rows, image cols, a single dimensional placeholder for number
% of filters, and number of measurements, but in the single
% measurement case the third dimension is collapsed so that the array
% is only 3d.
if size(S,3) > 1,
  xsz = size(X);
  % Insert singleton 3rd dimension (for number of filters) so that
  % 4th dimension is number of images in input s volume
  S = reshape(S, [size(S,1) size(S,2) 1 size(S,3)]);
else
  xsz = [size(X) 1];
end

% Set dsz to correct form
if numel(dsz) == 3, dsz = dsz(1:2); end

% Mean removal and normalisation projections
Pzmn = @(x) bsxfun(@minus, x, mean(mean(x,1),2));
Pnrm = @(x) normalise(x);

% Projection of filter to full image size and its transpose
% (zero-pad and crop respectively)
Pzp = @(x) zpad(x, xsz(1:2));
PzpT = @(x) bcrop(x, dsz);

% Projection of dictionary filters onto constraint set
if opt.ZeroMean,
  Pcn = @(x) Pnrm(Pzp(Pzmn(PzpT(x))));
else
  Pcn = @(x) Pnrm(Pzp(PzpT(x)));
end

% Start timer
tstart = tic;

% Compute coefficients in DFT domain
Xf = fft2(X, size(S,1), size(S,2));
% Compute signal in DFT domain
Sf = fft2(S);
% S convolved with all coefficients in DFT domain
XSf = sum(bsxfun(@times, conj(Xf), Sf), 4);

% Set up algorithm parameters and initialise variables
sigma = opt.sigma;
if isempty(sigma), sigma = size(S,3); end;
Nd = prod(xsz(1:3));
cgt = opt.CGTol;
optinf = struct('itstat', [], 'opt', opt);
r = Inf;
s = Inf;
epri = 0;
edua = 0;

% Initialise main working variables
D = []; Df = [];
if isempty(opt.G0),
  G = zeros([xsz(1) xsz(2) xsz(3)], class(S));
else
  G = opt.G0;
end
Gprv = G;
if isempty(opt.H0),
  if isempty(opt.G0),
    H = zeros([xsz(1) xsz(2) xsz(3)], class(S));
  else
    H = G;
  end
else
  H = opt.H0;
end

% Main loop
k = 1;
while k <= opt.MaxMainIter && (r > epri | s > edua),

  % Solve subproblems and update dual variable
  if strcmp(opt.LinSolve, 'SM'),
    Df = solvemdbi_ism(Xf, sigma, XSf + sigma*fft2(G - H));
  else
    [Df, cgst] = solvemdbi_cg(Xf, sigma, XSf + sigma*fft2(G - H), ...
                              cgt, opt.MaxCGIter, Df(:));
  end
  D = ifft2(Df, 'symmetric');

  % See pg. 21 of boyd-2010-distributed
  if opt.RelaxParam == 1,
    Dr = D;
  else
    Dr = opt.RelaxParam*D + (1-opt.RelaxParam)*G;
  end

  G = Pcn(Dr + H);
  H = H + Dr - G;

  % Compute data fidelity term in Fourier domain (note normalisation)
  if opt.AuxVarObj,
    Gf = fft2(G); % This represents unnecessary computational cost
    Job = sum(vec(abs(sum(bsxfun(@times,Gf,Xf),3)-Sf).^2))/(2*xsz(1)*xsz(2));
    Jcn = 0;
  else
    Job = sum(vec(abs(sum(bsxfun(@times,Df,Xf),3)-Sf).^2))/(2*xsz(1)*xsz(2));
    Jcn = norm(vec(Pcn(D) - D));
  end

  nD = norm(D(:)); nG = norm(G(:)); nH = norm(H(:));
  if opt.StdResiduals,
    % See pp. 19-20 of boyd-2010-distributed
    r = norm(vec(D - G));
    s = norm(vec(sigma*(Gprv - G)));
    epri = sqrt(Nd)*opt.AbsStopTol+max(nD,nG)*opt.RelStopTol;
    edua = sqrt(Nd)*opt.AbsStopTol+sigma*nH*opt.RelStopTol;
  else
    % See wohlberg-2015-adaptive
    r = norm(vec(D - G))/max(nD,nG);
    s = norm(vec(Gprv - G))/nH;
    epri = sqrt(Nd)*opt.AbsStopTol/max(nD,nG)+opt.RelStopTol;
    edua = sqrt(Nd)*opt.AbsStopTol/(sigma*nH)+opt.RelStopTol;
  end

  if opt.CGTolAuto && (r/opt.CGTolFactor) < cgt,
    cgt = r/opt.CGTolFactor;
  end

  % Record and display iteration details
  tk = toc(tstart);
  optinf.itstat = [optinf.itstat; [k Job Jcn r s epri edua sigma tk]];
  if opt.Verbose,
    if opt.AutoSigma,
      disp(sprintf(sfms, k, Job, Jcn, r, s, sigma));
    else
      disp(sprintf(sfms, k, Job, Jcn, r, s));
    end
  end

  % See wohlberg-2015-adaptive and pp. 20-21 of boyd-2010-distributed
  if opt.AutoSigma,
    if k ~= 1 && mod(k, opt.AutoSigmaPeriod) == 0,
      if opt.AutoSigmaScaling,
        sigmlt = sqrt(r/s);
        if sigmlt < 1, sigmlt = 1/sigmlt; end
        if sigmlt > opt.SigmaScaling, sigmlt = opt.SigmaScaling; end
      else
        sigmlt = opt.SigmaScaling;
      end
      ssf = 1;
      if r > opt.SigmaRsdlRatio*s, ssf = sigmlt; end
      if s > opt.SigmaRsdlRatio*r, ssf = 1/sigmlt; end
      sigma = ssf*sigma;
      H = H/ssf;
    end
  end

  Gprv = G;
  k = k + 1;

end

% Record run time and working variables
optinf.runtime = toc(tstart);
optinf.D = D;
optinf.G = G;
optinf.H = H;
optinf.sigma = sigma;
optinf.cgt = cgt;
if exist('cgst'), optinf.cgst = cgst; end

D = PzpT(G);

if opt.Verbose && opt.MaxMainIter > 0,
  disp(char('-' * ones(1,nsep)));
end

return

function u = vec(v)

  u = v(:);

return

function u = normalise(v)

  nrm = sqrt(sum(sum(v.^2, 1), 2));
  nrm(nrm == 0) = 1;
  u = bsxfun(@rdivide, v, nrm);

return

function u = zpad(v, sz)

  u = zeros(sz(1), sz(2), size(v,3), size(v,4), class(v));
  u(1:size(v,1), 1:size(v,2),:,:) = v;

return

function u = bcrop(v, sz)

  if numel(sz) <= 2,
    if numel(sz) == 1
      cs = [sz sz];
    else
      cs = sz;
    end
    u = v(1:cs(1), 1:cs(2), :);
  else
    if size(sz,1) < size(sz,2), sz = sz'; end
    cs = max(sz);
    u = zeros(cs(1), cs(2), size(v,3));
    for k = 1:size(v,3),
      u(1:sz(k,1), 1:sz(k,2), k) = v(1:sz(k,1), 1:sz(k,2), k);
    end
  end

return

function opt = defaultopts(opt)

  if ~isfield(opt,'Verbose'),
    opt.Verbose = 0;
  end
  if ~isfield(opt,'MaxMainIter'),
    opt.MaxMainIter = 200;
  end
  if ~isfield(opt,'AbsStopTol'),
    opt.AbsStopTol = 1e-6;
  end
  if ~isfield(opt,'RelStopTol'),
    opt.RelStopTol = 1e-4;
  end
  if ~isfield(opt,'G0'),
    opt.G0 = [];
  end
  if ~isfield(opt,'H0'),
    opt.H0 = [];
  end
  if ~isfield(opt,'sigma'),
    opt.sigma = [];
  end
  if ~isfield(opt,'AutoSigma'),
    opt.AutoSigma = 0;
  end
  if ~isfield(opt,'AutoSigmaPeriod'),
    opt.AutoSigmaPeriod = 10;
  end
  if ~isfield(opt,'SigmaRsdlRatio'),
    opt.SigmaRsdlRatio = 10;
  end
  if ~isfield(opt,'SigmaScaling'),
    opt.SigmaScaling = 2;
  end
  if ~isfield(opt,'AutoSigmaScaling'),
    opt.AutoSigmaScaling = 0;
  end
  if ~isfield(opt,'StdResiduals'),
    opt.StdResiduals = 0;
  end
  if ~isfield(opt,'RelaxParam'),
    opt.RelaxParam = 1;
  end
  if ~isfield(opt,'LinSolve'),
    opt.LinSolve = 'SM';
  end
  if ~isfield(opt,'MaxCGIter'),
    opt.MaxCGIter = 1000;
  end
  if ~isfield(opt,'CGTol'),
    opt.CGTol = 1e-3;
  end
  if ~isfield(opt,'CGTolAuto'),
    opt.CGTolAuto = 0;
  end
  if ~isfield(opt,'CGTolAutoFactor'),
    opt.CGTolFactor = 50;
  end
  if ~isfield(opt,'ZeroMean'),
    opt.ZeroMean = 0;
  end
  if ~isfield(opt,'AuxVarObj'),
    opt.AuxVarObj = 0;
  end

return


function c = multiprod(a, b, idA, idB)
%MULTIPROD  Multiplying 1-D or 2-D subarrays contained in two N-D arrays.
%   C = MULTIPROD(A,B) is equivalent  to C = MULTIPROD(A,B,[1 2],[1 2])
%   C = MULTIPROD(A,B,[D1 D2]) is eq. to C = MULTIPROD(A,B,[D1 D2],[D1 D2])
%   C = MULTIPROD(A,B,D1) is equival. to C = MULTIPROD(A,B,D1,D1)
%
%   MULTIPROD performs multiple matrix products, with array expansion (AX)
%   enabled. Its first two arguments A and B are "block arrays" of any
%   size, containing one or more 1-D or 2-D subarrays, called "blocks" (*).
%   For instance, a 5?6?3 array may be viewed as an array containing five
%   6?3 blocks. In this case, its size is denoted by 5?(6?3). The 1 or 2
%   adjacent dimensions along which the blocks are contained are called the
%   "internal dimensions" (IDs) of the array (?).
%
%   1) 2-D by 2-D BLOCK(S) (*)
%         C = MULTIPROD(A, B, [DA1 DA2], [DB1 DB2]) contains the products
%         of the P?Q matrices in A by the R?S matrices in B. [DA1 DA2] are
%         the IDs of A; [DB1 DB2] are the IDs of B.
%
%   2) 2-D by 1-D BLOCK(S) (*)
%         C = MULTIPROD(A, B, [DA1 DA2], DB1) contains the products of the
%         P?Q matrices in A by the R-element vectors in B. The latter are
%         considered to be R?1 matrices. [DA1 DA2] are the IDs of A; DB1 is
%         the ID of B.
%
%   3) 1-D by 2-D BLOCK(S) (*)
%         C = MULTIPROD(A, B, DA1, [DB1 DB2]) contains the products of the
%         Q-element vectors in A by the R?S matrices in B. The vectors in A
%         are considered to be 1?Q matrices. DA1 is the ID of A; [DB1 DB2]
%         are the IDs of B.
%
%   4) 1-D BY 1-D BLOCK(S) (*)
%      (a) If either SIZE(A, DA1) == 1 or SIZE(B, DB1) == 1, or both,
%             C = MULTIPROD(A, B, DA1, DB1) returns products of scalars by
%             vectors, or vectors by scalars or scalars by scalars.
%      (b) If SIZE(A, DA1) == SIZE(B, DB1),
%             C = MULTIPROD(A, B, [0 DA1], [DB1 0]) or
%             C = MULTIPROD(A, B, DA1, DB1) virtually turns the vectors
%             contained in A and B into 1?P and P?1 matrices, respectively,
%             then returns their products, similar to scalar products.
%             Namely, C = DOT2(A, B, DA1, DB1) is equivalent to
%             C = MULTIPROD(CONJ(A), B, [0 DA1], [DB1 0]).
%      (c) Without limitations on the length of the vectors in A and B,
%             C = MULTIPROD(A, B, [DA1 0], [0 DB1]) turns the vectors
%             contained in A and B into P?1 and 1?Q matrices, respectively,
%             then returns their products, similar to outer products.
%             Namely, C = OUTER(A, B, DA1, DB1) is equivalent to
%             C = MULTIPROD(CONJ(A), B, [DA1 0], [0 DB1]).
%
%   Common constraints for all syntaxes:
%      The external dimensions of A and B must either be identical or
%      compatible with AX rules. The internal dimensions of each block
%      array must be adjacent (DA2 == DA1 + 1 and DB2 == DB1 + 1 are
%      required). DA1 and DB1 are allowed to be larger than NDIMS(A) and
%      NDIMS(B). In syntaxes 1, 2, and 3, Q == R is required, unless the
%      blocks in A or B are scalars.
%
%   Array expansion (AX):
%      AX is a powerful generalization to N-D of the concept of scalar
%      expansion. Indeed, A and B may be scalars, vectors, matrices or
%      multi-dimensional arrays. Scalar expansion is the virtual
%      replication or annihilation of a scalar which allows you to combine
%      it, element by element, with an array X of any size (e.g. X+10,
%      X*10, or []-10). Similarly, in MULTIPROD, the purpose of AX is to
%      automatically match the size of the external dimensions (EDs) of A
%      and B, so that block-by-block products can be performed. ED matching
%      is achieved by means of a dimension shift followed by a singleton
%      expansion:
%      1) Dimension shift (see SHIFTDIM).
%            Whenever DA1 ~= DB1, a shift is applied to impose DA1 == DB1.
%            If DA1 > DB1, B is shifted to the right by DA1 - DB1 steps.
%            If DB1 > DA1, A is shifted to the right by DB1 - DA1 steps.
%      2) Singleton expansion (SX).
%            Whenever an ED of either A or B is singleton and the
%            corresponding ED of the other array is not, the mismatch is
%            fixed by virtually replicating the array (or diminishing it to
%            length 0) along that dimension.
%
%   MULTIPROD is a generalization for N-D arrays of the matrix
%   multiplication function MTIMES, with AX enabled. Vector inner, outer,
%   and cross products generalized for N-D arrays and with AX enabled are
%   performed by DOT2, OUTER, and CROSS2 (MATLAB Central, file #8782).
%   Elementwise multiplications (see TIMES) and other elementwise binary
%   operations with AX enabled are performed by BAXFUN (MATLAB Central,
%   file #23084). Together, these functions make up the ?ARRAYLAB toolbox?.
%
%   Input and output format:
%      The size of the EDs of C is determined by AX. Block size is
%      determined as follows, for each of the above-listed syntaxes:
%      1) C contains P?S matrices along IDs MAX([DA1 DA2], [DB1 DB2]).
%      2) Array     Block size     ID(s)
%         ----------------------------------------------------
%         A         P?Q  (2-D)     [DA1 DA2]
%         B         R    (1-D)     DB1
%         C (a)     P    (1-D)     MAX(DA1, DB1)
%         C (b)     P?Q  (2-D)     MAX([DA1 DA2], [DB1 DB1+1])
%         ----------------------------------------------------
%         (a) The 1-D blocks in B are not scalars (R > 1).
%         (b) The 1-D blocks in B are scalars (R = 1).
%      3) Array     Block size     ID(s)
%         ----------------------------------------------------
%         A           Q  (1-D)     DA1
%         B         R?S  (2-D)     [DB1 DB2]
%         C (a)       S  (1-D)     MAX(DA1, DB1)
%         C (b)     R?S  (2-D)     MAX([DA1 DA1+1], [DB1 DB2])
%         ----------------------------------------------------
%         (a) The 1-D blocks in A are not scalars (Q > 1).
%         (b) The 1-D blocks in A are scalars (Q = 1).
%      4)     Array     Block size         ID(s)
%         --------------------------------------------------------------
%         (a) A         P        (1-D)     DA1
%             B         Q        (1-D)     DB1
%             C         MAX(P,Q) (1-D)     MAX(DA1, DB1)
%         --------------------------------------------------------------
%         (b) A         P        (1-D)     DA1
%             B         P        (1-D)     DB1
%             C         1        (1-D)     MAX(DA1, DB1)
%         --------------------------------------------------------------
%         (c) A         P        (1-D)     DA1
%             B         Q        (1-D)     DB1
%             C         P?Q      (2-D)     MAX([DA1 DA1+1], [DB1 DB1+1])
%         --------------------------------------------------------------
%
%   Terminological notes:
%   (*) 1-D and 2-D blocks are generically referred to as "vectors" and
%       "matrices", respectively. However, both may be also called
%       ?scalars? if they have a single element. Moreover, matrices with a
%       single row or column (e.g. 1?3 or 3?1) may be also called ?row
%       vectors? or ?column vectors?.
%   (?) Not to be confused with the "inner dimensions" of the two matrices
%       involved in a product X * Y, defined as the 2nd dimension of X and
%       the 1st of Y (DA2 and DB1 in syntaxes 1, 2, 3).
%
%   Examples:
%    1) If  A is .................... a 5?(6?3)?2 array,
%       and B is .................... a 5?(3?4)?2 array,
%       C = MULTIPROD(A, B, [2 3]) is a 5?(6?4)?2 array.
%
%       A single matrix A pre-multiplies each matrix in B
%       If  A is ........................... a (1?3)    single matrix,
%       and B is ........................... a 10?(3?4) 3-D array,
%       C = MULTIPROD(A, B, [1 2], [3 4]) is a 10?(1?4) 3-D array.
%
%       Each matrix in A pre-multiplies each matrix in B (all possible
%       combinations)
%       If  A is .................... a (6?3)?5   array,
%       and B is .................... a (3?4)?1?2 array,
%       C = MULTIPROD(A, B, [1 2]) is a (6?4)?5?2 array.
%
%   2a) If  A is ........................... a 5?(6?3)?2 4-D array,
%       and B is ........................... a 5?(3)?2   3-D array,
%       C = MULTIPROD(A, B, [2 3], [2]) is   a 5?(6)?2   3-D array.
%
%   2b) If  A is ........................... a 5?(6?3)?2 4-D array,
%       and B is ........................... a 5?(1)?2   3-D array,
%       C = MULTIPROD(A, B, [2 3], [2]) is   a 5?(6?3)?2 4-D array.
%
%   4a) If both A and B are .................. 5?(6)?2   3-D arrays,
%       C = MULTIPROD(A, B, 2) is .......... a 5?(1)?2   3-D array, while
%   4b) C = MULTIPROD(A, B, [2 0], [0 2]) is a 5?(6?6)?2 4-D array
%
%   See also DOT2, OUTER, CROSS2, BAXFUN, MULTITRANSP, MULTITRACE, MULTISCALE.

% $ Version: 2.1 $
% CODE      by:            Paolo de Leva
%                          (Univ. of Rome, Foro Italico, IT)    2009 Jan 24
%           optimized by:  Paolo de Leva
%                          Jinhui Bai (Georgetown Univ., D.C.)  2009 Jan 24
% COMMENTS  by:            Paolo de Leva                        2009 Feb 24
% OUTPUT    tested by:     Paolo de Leva                        2009 Feb 24
% -------------------------------------------------------------------------

%error( nargchk(2, 4, nargin) ); % Allow 2 to 4 input arguments % HK
narginchk(2, 4); % added by HK
switch nargin % Setting IDA and/or IDB
    case 2, idA = [1 2]; idB = [1 2];
    case 3, idB = idA;
end

% ESC 1 - Special simple case (both A and B are 2D), solved using C = A * B

     if ndims(a)==2 && ndims(b)==2 && ...
         isequal(idA,[1 2]) && isequal(idB,[1 2])
         c = a * b; return
     end

% MAIN 0 - Checking and evaluating array size, block size, and IDs

     sizeA0 = size(a);
     sizeB0 = size(b);
     [sizeA, sizeB, shiftC, delC, sizeisnew, idA, idB, ...
     squashOK, sxtimesOK, timesOK, mtimesOK, sumOK] = ...
                                           sizeval(idA,idB, sizeA0,sizeB0);

% MAIN 1 - Applying dimension shift (first step of AX) and
%          turning both A and B into arrays of either 1-D or 2-D blocks

     if sizeisnew(1), a = reshape(a, sizeA); end
     if sizeisnew(2), b = reshape(b, sizeB); end

% MAIN 2 - Performing products with or without SX (second step of AX)

     if squashOK % SQUASH + MTIMES (fastest engine)
         c = squash2D_mtimes(a,b, idA,idB, sizeA,sizeB, squashOK);
     elseif timesOK % TIMES (preferred w.r. to SX + TIMES)
         if sumOK, c = sum(a .* b, sumOK);
         else      c =     a .* b; end
     elseif sxtimesOK % SX + TIMES
         if sumOK, c = sum(bsxfun(@times, a, b), sumOK);
         else      c =     bsxfun(@times, a, b); end
     elseif mtimesOK % MTIMES (rarely used)
         c = a * b;
     end

% MAIN 3 - Reshaping C (by inserting or removing singleton dimensions)

     [sizeC sizeCisnew] = adjustsize(size(c), shiftC, false, delC, false);
     if sizeCisnew, c = reshape(c, sizeC); end

function c = squash2D_mtimes(a, b, idA, idB, sizeA, sizeB, squashOK)
% SQUASH2D_MTIMES  Multiproduct with single-block expansion (SBX).
%    Actually, no expansion is performed. The multi-block array is
%    rearranged from N-D to 2-D, then MTIMES is applied, and eventually the
%    result is rearranged back to N-D. No additional memory is required.
%    One and only one of the two arrays must be single-block, and its IDs
%    must be [1 2] (MAIN 1 removes leading singletons). Both arrays
%    must contain 2-D blocks (MAIN 1 expands 1-D blocks to 2-D).

    if squashOK == 1 % A is multi-block, B is single-block (squashing A)

        % STEP 1 - Moving IDA(2) to last dimension
        nd = length(sizeA);
        d2 = idA(2);
        order = [1:(d2-1) (d2+1):nd d2]; % Partial shifting
        a = permute(a, order); % ...?Q

        % STEP 2 - Squashing A from N-D to 2-D
        q = sizeB(1);
        s = sizeB(2);
        lengthorder = length(order);
        collapsedsize = sizeA(order(1:lengthorder-1));
        n = prod(collapsedsize);
        a = reshape(a, [n, q]); % N?Q
        fullsize = [collapsedsize s]; % Size to reshape C back to N-D

    else % B is multi-block, A is single-block (squashing B)

        % STEP 1 - Moving IDB(1) to first dimension
        nd = length(sizeB);
        d1 = idB(1);
        order = [d1 1:(d1-1) (d1+1):nd]; % Partial shifting
        b = permute(b, order); % Q?...

        % STEP 2 - Squashing B from N-D to 2-D
        p = sizeA(1);
        q = sizeA(2);
        lengthorder = length(order);
        collapsedsize = sizeB(order(2:lengthorder));
        n = prod(collapsedsize);
        b = reshape(b, [q, n]); % Q?N
        fullsize = [p collapsedsize]; % Size to reshape C back to N-D

    end

    % FINAL STEPS - Multiplication, reshape to N-D, inverse permutation
    invorder(order) = 1 : lengthorder;
    c = permute (reshape(a*b, fullsize), invorder);

function [sizeA, sizeB, shiftC, delC, sizeisnew, idA, idB, ...
          squashOK, sxtimesOK, timesOK, mtimesOK, sumOK] = ...
                                          sizeval(idA0,idB0, sizeA0,sizeB0)
%SIZEVAL   Evaluation of array size, block size, and IDs
%    Possible values for IDA and IDB:
%        [DA1 DA2], [DB1 DB2]
%        [DA1 DA2], [DB1]
%        [DA1],     [DB1 DB2]
%        [DA1],     [DB1]
%        [DA1 0],   [0 DB1]
%        [0 DA1],   [DB1 0]
%
%    sizeA/B     Equal to sizeA0/B0 if RESHAPE is not needed in MAIN 1
%    shiftC, delC    Variables controlling MAIN 3.
%    sizeisnew   1x2 logical array; activates reshaping of A and B.
%    idA/B       May change only if squashOK ~= 0
%    squashOK    If only A or B is a multi-block array (M-B) and the other
%                is single-block (1-B), it will be rearranged from N-D to
%                2-D. If both A and B are 1-B or M-B arrays, squashOK = 0.
%                If only A (or B) is a M-B array, squashOK = 1 (or 2).
%    sxtimesOK, timesOK, mtimesOK    Flags controlling MAIN 2 (TRUE/FALSE).
%    sumOK       Dimension along which SUM is performed. If SUM is not
%                needed, sumOK = 0.

% Initializing output arguments

    idA = idA0;
    idB = idB0;
     squashOK = 0;
    sxtimesOK = false;
      timesOK = false;
     mtimesOK = false;
        sumOK = 0;
    shiftC = 0;
    delC = 0;

% Checking for gross input errors

    NidA = numel(idA);
    NidB = numel(idB);
    idA1 = idA(1);
    idB1 = idB(1);
    if  NidA>2 || NidB>2 || NidA==0 || NidB==0 || ...
           ~isreal(idA1) ||    ~isreal(idB1)   || ...
        ~isnumeric(idA1) || ~isnumeric(idB1)   || ...
                 0>idA1  ||          0>idB1    || ... % negative
         idA1~=fix(idA1) ||  idB1~=fix(idB1)   || ... % non-integer
         ~isfinite(idA1) ||  ~isfinite(idB1) % Inf or NaN
        error('MULTIPROD:InvalidDimensionArgument', ...
        ['Internal-dimension arguments (e.g., [IDA1 IDA2]) must\n', ...
         'contain only one or two non-negative finite integers']);
    end

% Checking Syntaxes containing zeros (4b/c)

    declared_outer = false;
    idA2 = idA(NidA); % It may be IDA1 = IDA2 (1-D block)
    idB2 = idB(NidB);

    if any(idA==0) || any(idB==0)

        % "Inner products": C = MULTIPROD(A, B, [0 DA1], [DB1 0])
        if idA1==0 && idA2>0 && idB1>0 && idB2==0
            idA1 = idA2;
            idB2 = idB1;
        % "Outer products": C = MULTIPROD(A, B, [DA1 0], [0 DB1])
        elseif idA1>0 && idA2==0 && idB1==0 && idB2>0
            declared_outer = true;
            idA2 = idA1;
            idB1 = idB2;
        else
            error('MULTIPROD:InvalidDimensionArgument', ...
            ['Misused zeros in the internal-dimension arguments\n', ...
            '(see help heads 4b and 4c)']);
        end
        NidA = 1;
        NidB = 1;
        idA = idA1;
        idB = idB1;

    elseif (NidA==2 && idA2~=idA1+1) || ...  % Non-adjacent IDs
           (NidB==2 && idB2~=idB1+1)
        error('MULTIPROD:InvalidDimensionArgument', ...
        ['If an array contains 2-D blocks, its two internal dimensions', ...
        'must be adjacent (e.g. IDA2 == IDA1+1)']);
    end

% ESC - Case for which no reshaping is needed (both A and B are scalars)

    scalarA = isequal(sizeA0, [1 1]);
    scalarB = isequal(sizeB0, [1 1]);
    if scalarA && scalarB
        sizeA = sizeA0;
        sizeB = sizeB0;
        sizeisnew = [false false];
        timesOK = true; return
    end

% Computing and checking adjusted sizes
% The lengths of ADJSIZEA and ADJSIZEB must be >= IDA(END) and IDB(END)

    NsA = idA2 - length(sizeA0); % Number of added trailing singletons
    NsB = idB2 - length(sizeB0);
    adjsizeA = [sizeA0 ones(1,NsA)];
    adjsizeB = [sizeB0 ones(1,NsB)];
    extsizeA = adjsizeA([1:idA1-1, idA2+1:end]); % Size of EDs
    extsizeB = adjsizeB([1:idB1-1, idB2+1:end]);
    p = adjsizeA(idA1);
    q = adjsizeA(idA2);
    r = adjsizeB(idB1);
    s = adjsizeB(idB2);
    scalarsinA = (p==1 && q==1);
    scalarsinB = (r==1 && s==1);
    singleA = all(extsizeA==1);
    singleB = all(extsizeB==1);
    if q~=r && ~scalarsinA && ~scalarsinB && ~declared_outer
       error('MULTIPROD:InnerDimensionsMismatch', ...
             'Inner matrix dimensions must agree.');
    end

% STEP 1/3 - DIMENSION SHIFTING (FIRST STEP OF AX)
%   Pipeline 1 (using TIMES) never needs left, and may need right shifting.
%   Pipeline 2 (using MTIMES) may need left shifting of A and right of B.

    shiftA = 0;
    shiftB = 0;
    diffBA = idB1 - idA1;
    if scalarA % Do nothing
    elseif singleA && ~scalarsinB, shiftA = -idA1 + 1; %  Left shifting A
    elseif idB1 > idA1,            shiftA = diffBA;    % Right shifting A
    end
    if scalarB % Do nothing
    elseif singleB && ~scalarsinA, shiftB = -idB1 + 1; %  Left shifting B
    elseif idA1 > idB1,            shiftB = -diffBA;   % Right shifting B
    end

% STEP 2/3 - SELECTION OF PROPER ENGINE AND BLOCK SIZE ADJUSTMENTS

    addA  = 0; addB  = 0;
    delA  = 0; delB  = 0;
    swapA = 0; swapB = 0;
    idC1 = max(idA1, idB1);
    idC2 = idC1 + 1;
    checktimes = false;

    if (singleA||singleB) &&~scalarsinA &&~scalarsinB % Engine using MTIMES

        if singleA && singleB
            mtimesOK = true;
            shiftC=idC1-1; % Right shifting C
            idC1=1; idC2=2;
        elseif singleA
            squashOK = 2;
            idB = [idB1, idB1+1] + shiftB;
        else % singleB
            squashOK = 1;
            idA = [idA1, idA1+1] + shiftA;
        end

        if NidA==2 && NidB==2 % 1) 2-D BLOCKS BY 2-D BLOCKS
            % OK
        elseif NidA==2        % 2) 2-D BLOCKS BY 1-D BLOCKS
            addB=idB1+1; delC=idC2;
        elseif NidB==2        % 3) 1-D BLOCKS BY 2-D BLOCKS
            addA=idA1; delC=idC1;
        else                  % 4) 1-D BLOCKS BY 1-D BLOCKS
            if declared_outer
                addA=idA1+1; addB=idB1;
            else
                addA=idA1; addB=idB1+1; delC=idC2;
            end
        end

    else % Engine using TIMES (also used if SCALARA || SCALARB)

        sxtimesOK = true;

        if NidA==2 && NidB==2 % 1) 2-D BLOCKS BY 2-D BLOCKS

            if scalarA || scalarB
                timesOK=true;
            elseif scalarsinA && scalarsinB % scal-by-scal
                checktimes=true;
            elseif scalarsinA || scalarsinB || ... % scal-by-mat
                (q==1 && r==1)  % vec-by-vec ("outer")
            elseif p==1 && s==1 % vec-by-vec ("inner")
                swapA=idA1; sumOK=idC1; checktimes=true;
            elseif s==1 % mat-by-vec
                swapB=idB1; sumOK=idC2;
            elseif p==1 % vec-by-mat
                swapA=idA1; sumOK=idC1;
            else % mat-by-mat
                addA=idA2+1; addB=idB1; sumOK=idC2; delC=idC2;
            end

        elseif NidA==2 % 2) 2-D BLOCKS BY 1-D BLOCKS

            if scalarA || scalarB
                timesOK=true;
            elseif scalarsinA && scalarsinB % scal-by-scal
                addB=idB1; checktimes=true;
            elseif scalarsinA % scal-by-vec
                delA=idA1;
            elseif scalarsinB % mat-by-scal
                addB=idB1;
            elseif p==1 % vec-by-vec ("inner")
                delA=idA1; sumOK=idC1; checktimes=true;
            else % mat-by-vec
                addB=idB1; sumOK=idC2; delC=idC2;
            end

        elseif NidB==2 % 3) 1-D BLOCKS BY 2-D BLOCKS

            if scalarA || scalarB
                timesOK=true;
            elseif scalarsinA && scalarsinB % scal-by-scal
                addA=idA1+1; checktimes=true;
            elseif scalarsinB % vec-by-scal
                delB=idB2;
            elseif scalarsinA % scal-by-mat
                addA=idA1+1;
            elseif s==1 % vec-by-vec ("inner")
                delB=idB2; sumOK=idC1; checktimes=true;
            else % vec-by-mat
                addA=idA1+1; sumOK=idC1; delC=idC1;
            end

        else % 4) 1-D BLOCKS BY 1-D BLOCKS

            if scalarA || scalarB
                timesOK=true;
            elseif declared_outer % vec-by-vec ("outer")
                addA=idA1+1; addB=idB1;
            elseif scalarsinA && scalarsinB % scal-by-scal
                checktimes=true;
            elseif scalarsinA || scalarsinB % vec-by-scal
            else % vec-by-vec
                sumOK=idC1; checktimes=true;
            end
        end
    end

% STEP 3/3 - Adjusting the size of A and B. The size of C is adjusted
%            later, because it is not known yet.

    [sizeA, sizeisnew(1)] = adjustsize(sizeA0, shiftA, addA, delA, swapA);
    [sizeB, sizeisnew(2)] = adjustsize(sizeB0, shiftB, addB, delB, swapB);

    if checktimes % Faster than calling BBXFUN
        diff = length(sizeB) - length(sizeA);
        if isequal([sizeA ones(1,diff)], [sizeB ones(1,-diff)])
            timesOK = true;
        end
    end

function [sizeA, sizeisnew] = adjustsize(sizeA0, shiftA, addA, delA, swapA)
% ADJUSTSIZE  Adjusting size of a block array.

    % Dimension shifting (by adding or deleting trailing singleton dim.)
    if     shiftA>0, [sizeA,newA1] = addsing(sizeA0, 1, shiftA);
    elseif shiftA<0, [sizeA,newA1] = delsing(sizeA0, 1,-shiftA);
    else   sizeA = sizeA0;  newA1  = false;
    end
    % Modifying block size (by adding, deleting, or moving singleton dim.)
    if      addA, [sizeA,newA2] = addsing(sizeA, addA+shiftA, 1); % 1D-->2D
    elseif  delA, [sizeA,newA2] = delsing(sizeA, delA+shiftA, 1); % 2D-->1D
    elseif swapA, [sizeA,newA2] = swapdim(sizeA,swapA+shiftA); % ID Swapping
    else                 newA2  = false;
    end
    sizeisnew = newA1 || newA2;

function [newsize, flag] = addsing(size0, dim, ns)
%ADDSING   Adding NS singleton dimensions to the size of an array.
%   Warning: NS is assumed to be a positive integer.
%   Example: If the size of A is ..... SIZE0 = [5 9 3]
%            NEWSIZE = ADDSING(SIZE0, 3, 2) is [5 9 1 1 3]

    if dim > length(size0)
        newsize = size0;
        flag = false;
    else
        newsize = [size0(1:dim-1), ones(1,ns), size0(dim:end)];
        flag = true;
    end

function [newsize, flag] = delsing(size0, dim, ns)
%DELSING   Removing NS singleton dimensions from the size of an array.
%   Warning: Trailing singletons are not removed
%   Example: If the size of A is SIZE0 = [1 1 1 5 9 3]
%            NEWSIZE = DELSING(SIZE, 1, 3) is  [5 9 3]

    if dim > length(size0)-ns % Trailing singletons are not removed
        newsize = size0;
        flag = false;
    else % Trailing singl. added, so NEWSIZE is guaranteed to be 2D or more
        newsize = size0([1:dim-1, dim+ns:end, dim]);
        flag = true;
    end

function [newsize, flag] = swapdim(size0, dim)
%SWAPDIM   Swapping two adjacent dimensions of an array (DIM and DIM+1).
%   Used only when both A and B are multi-block arrays with 2-D blocks.
%   Example: If the size of A is .......... 5?(6?3)
%            NEWSIZE = SWAPIDS(SIZE0, 2) is 5?(3?6)

    newsize = [size0 1]; % Guarantees that dimension DIM+1 exists.
    newsize = newsize([1:dim-1, dim+1, dim, dim+2:end]);
    flag = true;


function f = times(f, g)
%.*   CHEBFUN multiplication.
%   F.*G multiplies F and G, where F and G may be CHEBFUN objects or scalars.
%   If F and/or G is array-valued, the dimensions must match.
%
% See also MTIMES.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

% Deal with the special cases:
if ( ~isa(f, 'chebfun') )      % ??? * CHEBFUN

    % Ensure CHEBFUN is the first input:
    if ( ~g(1).isTransposed )
        f = times(g, f);
    else
        f = times(g.', f.').';
    end

elseif ( isempty(g) )          % CHEBFUN * []

    f = [];
    return

elseif ( isempty(f) )          % empty CHEBFUN * CHEBFUN

    % Nothing to do here. (Return an empty CHEBFUN as output.)
    return

elseif ( isnumeric(g) )        % CHEBFUN * double

    if ( numel(f) == 1 )
        % Array-valued case:

        % Loop over the funs:
        for k = 1:numel(f.funs)
            f.funs{k} = times(f.funs{k}, g);
        end

        % Multiply the pointValues:
        if ( numel(g) > 1 )
            f.pointValues = bsxfun(@times, f.pointValues, g);
        else
            f.pointValues = f.pointValues .* g;
        end

    else
        % Quasimatrix case:

        numCols = numel(f);
        % Promote g if required:
        if ( ~isscalar(g) )
            error('CHEBFUN:CHEBFUN:times:dim', 'Matrix dimensions must agree.');
        end
        % Loop over the columns:
        for k = 1:numCols
            f(k) = f(k).*g;
        end

    end

elseif ( ~isa(g, 'chebfun') )  % CHEBFUN * ???

    error('CHEBFUN:CHEBFUN:times:unknown', ...
          ['Undefined function ''times'' for input arguments of type ' ...
           '%s and %s.'], class(f), class(g));

else                           % CHEBFUN .* CHEBFUN

    % Check to see if one of the CHEBFUNs is transposed:
    if ( xor(f(1).isTransposed, g(1).isTransposed) )
        error('CHEBFUN:CHEBFUN:times:matdim', ...
            'Matrix dimensions must agree. (One input is transposed).');
    end

    dimCheck(f, g);

    if ( numel(f) == 1 && numel(g) == 1 )
        % CHEBFUN case:

        % If one of the two CHEBFUNs uses a PERIODICTECH reprensetation,
        % cast it to a NONPERIODICTECH.
        if ( ~isPeriodicTech(f.funs{1}) && isPeriodicTech(g.funs{1}) )
            g = chebfun(g, g.domain, 'tech', get(f.funs{1}, 'tech'));
        elseif ( isPeriodicTech(f.funs{1}) && ~isPeriodicTech(g.funs{1}) )
            f = chebfun(f, f.domain, 'tech', get(g.funs{1}, 'tech'));
        end

        % Overlap:
        [f, g] = overlap(f, g);

        % Loop over the FUNs:
        for k = 1:numel(f.funs)
            f.funs{k} = times(f.funs{k}, g.funs{k});
        end
        f.pointValues = f.pointValues .* g.pointValues;

    else
        % QUASIMATRIX case:

        % Convert to cell for simplicity
        f = cheb2cell(f);
        g = cheb2cell(g);

        % Loop over the columns:
        if ( numel(f) == 1 )
            for k = numel(g):-1:1
                h(k) = f{1} .* g{k};
            end
        elseif ( numel(g) == 1 )
            for k = numel(f):-1:1
                h(k) = f{k} .* g{1};
            end
        else % numel(f) = numel(g)
            for k = numel(f):-1:1
                h(k) = f{k} .* g{k};
            end
        end
        f = h;
    end
end

% Set small breakpoint values to zero:
f = thresholdBreakpointValues(f);

end


%扩频函数
function [out] = spread(data, code)

% ****************************************************************
%   data   : 输入数据序列
%   code   : 扩频码序列
%   out    : 扩频后的输出数据序列
% ****************************************************************

switch nargin
case { 0 , 1 }                                  %如果输入参数个数不对，提示错误
    error('缺少输入参数');
end

[hn,vn] = size(data);
[hc,vc] = size(code);

if hn > hc                                      %如果扩频码数小于输入的待扩频的数据序列，提示错误
    error('缺少扩频码序列');
end

out = zeros(hn,vn*vc);

for ii=1:hn
    out(ii,:) = reshape(code(ii,:).'*data(ii,:),1,vn*vc);
end

%******************************** end of file ********************************


%%*****************************************************************************
%% checkdepconst: compute AAt to determine if the
%%             constraint matrices Ak are linearly independent.
%%
%% [At,b,y,idxB,neardepconstr,feasible,AAt] = checkdepconstr(blk,At,b,y,rmdepconstr);
%%
%% rmdepconstr = 1, if want to remove dependent columns in At
%%             = 0, otherwise.
%%
%% idxB = indices of linearly independent columns of original At.
%% neardepconstr = 1 if there is nearly dependent columns in At
%%            = 0, otherwise.
%% Note: the definition of "nearly dependent" is dependent on the
%%       threshold used to determine the small diagonal elements in
%%       the LDLt factorization of A*At.
%%
%% SDPT3: version 3.1
%% Copyright (c) 1997 by
%% K.C. Toh, M.J. Todd, R.H. Tutuncu
%% Last Modified: 16 Sep 2004
%%*****************************************************************************

function  [At,b,y,idxB,neardepconstr,feasible,AAt] = ...
    checkdepconstr(blk,At,b,y,rmdepconstr)

global existlowrank printlevel
global nnzmatold
%%
%% compute AAt
%%
m = length(b);
AAt = sparse(m,m);  numdencol = 0; UU = [];
for p = 1:size(blk,1)
    pblk = blk(p,:);
    if strcmp(pblk{1},'s');
        m1 = size(At{p,1},2); m2 = m - m1;
        if (m2 > 0)
            if (m2 > 0.3*m); AAt = full(AAt); end
            dd = At{p,3};
            lenn = size(dd,1);
            idxD = [0; find(diff(dd(:,1))); lenn];
            ss = [0, cumsum(pblk{3})];
            if (existlowrank)
                AAt(1:m1,1:m1) = AAt(1:m1,1:m1) + At{p,1}'*At{p,1}; %#ok
                for k = 1:m2
                    idx = ss(k)+1 : ss(k+1);
                    idx2 = idxD(k)+1: idxD(k+1);
                    ii = dd(idx2,2)-ss(k); %% undo cumulative indexing
                    jj = dd(idx2,3)-ss(k);
                    len = pblk{3}(k);
                    Dk = spconvert([ii,jj,dd(idx2,4); len,len,0]);
                    tmp = svec(pblk,At{p,2}(:,idx)*Dk*At{p,2}(:,idx)');
                    tmp2 = AAt(1:m1,m1+k) + (tmp'*At{p,1})';
                    AAt(1:m1,m1+k) = tmp2; %#ok
                    AAt(m1+k,1:m1) = tmp2'; %#ok
                end
            end
            DD = spconvert([dd(:,2:4); sum(pblk{3}),sum(pblk{3}),0]);
            VtVD = (At{p,2}'*At{p,2})*DD;
            VtVD2 = VtVD'.*VtVD;
            for k = 1:m2
                idx0 = ss(k)+1 : ss(k+1);
                %%tmp = VtVD(idx0,:)' .* VtVD(:,idx0);
                tmp = VtVD2(:,idx0);
                tmp = tmp*ones(length(idx0),1);
                tmp3 = AAt(m1+1:m1+m2,m1+k) + mexqops(pblk{3},tmp,ones(length(tmp),1),1);
                AAt(m1+1:m1+m2,m1+k) = tmp3; %#ok
            end
        else
            AAt = AAt + abs(At{p,1})'*abs(At{p,1});
        end
    else
        decolidx = checkdense(At{p,1}');
        if ~isempty(decolidx);
            n2 = size(At{p,1},1);
            dd = ones(n2,1);
            len= length(decolidx);
            dd(decolidx) = zeros(len,1);
            AAt = AAt + (abs(At{p,1})' *spdiags(dd,0,n2,n2)) *abs(At{p,1});
            tmp = At{p,1}(decolidx,:)';
            UU = [UU, tmp]; %#ok
            numdencol = numdencol + len;
        else
            AAt = AAt + abs(At{p,1})'*abs(At{p,1});
        end
    end
end
if (numdencol > 0) && (printlevel)
    fprintf('\n number of dense column in A = %d',numdencol);
end
numdencol = size(UU,2);
%%
%%
%%
feasible = 1; neardepconstr = 0;
if ~issparse(AAt); AAt = sparse(AAt); end
nnzmatold = mexnnz(AAt);
rho = 1e-15;
diagAAt = diag(AAt);
mexschurfun(AAt,rho*max(diagAAt,1));
[L.R,indef,L.perm] = chol(AAt,'vector');
L.d = full(diag(L.R)).^2;
if (indef)
    msg = 'AAt is not pos. def.';
    idxB = 1:m;
    neardepconstr = 1;
    if (printlevel); fprintf('\n checkdepconstr: %s',msg); end
    return;
end
%%
%% find independent rows of A
%%
dd = zeros(m,1);
idxB = (1:m)';
dd(L.perm) = abs(L.d);
idxN = find(dd < 1e-13*mean(L.d));
ddB = dd(setdiff(1:m,idxN));
ddN = dd(idxN);
if ~isempty(ddN) && ~isempty(ddB) && (min(ddB)/max(ddN) < 10)
    %% no clear separation of elements in dd
    %% do not label constraints as dependent
    idxN = [];
end
if ~isempty(idxN)
    neardepconstr = 1;
    if (printlevel)
        fprintf('\n number of nearly dependent constraints = %1.0d',length(idxN));
    end
    if (numdencol==0)
        if (rmdepconstr)
            idxB = setdiff((1:m)',idxN);
            if (printlevel)
                fprintf('\n checkdepconstr: removing dependent constraints...');
            end
            [W,resnorm] = findcoeffsub(blk,At,idxB,idxN);
            tol = 1e-8;
            if (resnorm > sqrt(tol))
                idxB = (1:m)';
                neardepconstr = 0;
                if (printlevel)
                    fprintf('\n checkdepconstr: basis rows cannot be reliably identified,');
                    fprintf(' abort removing nearly dependent constraints');
                end
                return;
            end
            tmp = W'*b(idxB) - b(idxN);
            nnorm = norm(tmp)/max(1,norm(b));
            if (nnorm > tol)
                feasible = 0;
                if (printlevel)
                    fprintf('\n checkdepconstr: inconsistent constraints exist,');
                    fprintf(' problem is infeasible.');
                end
            else
                feasible = 1;
                for p = 1:size(blk,1)
                    At{p,1} = At{p,1}(:,idxB);
                end
                b = b(idxB);
                y = y(idxB);
                AAt = AAt(idxB,idxB);
            end
        else
            if (printlevel)
                fprintf('\n To remove these constraints,');
                fprintf(' re-run sqlp.m with OPTIONS.rmdepconstr = 1.');
            end
        end
    else
        if (printlevel)
            fprintf('\n warning: the sparse part of AAt may be nearly singular.');
        end
    end
end
%%*****************************************************************************
%% findcoeffsub:
%%
%% [W,resnorm] = findcoeffsub(blk,At,idXB,idXN);
%%
%% idXB = indices of independent columns of At.
%% idxN = indices of   dependent columns of At.
%%
%% AB = At(:,idxB); AN = At(:,idxN) = AB*W
%%
%% SDPT3: version 3.0
%% Copyright (c) 1997 by
%% K.C. Toh, M.J. Todd, R.H. Tutuncu
%% Last modified: 2 Feb 01
%%*****************************************************************************

function [W,resnorm] = findcoeffsub(blk,At,idxB,idxN)

AB = []; AN = [];
for p = 1:size(blk,1)
    AB = [AB; At{p,1}(:,idxB)]; %#ok
    AN = [AN; At{p,1}(:,idxN)]; %#ok
end
n = size(AB,2);
%%
%%-----------------------------------------
%% find W so that AN = AB*W
%%-----------------------------------------
%%
[L,U,P,Q] = lu(sparse(AB));
rhs  = P*AN;
Lhat = L(1:n,:);
W = Q*( U \ (Lhat \ rhs(1:n,:)));
resnorm = norm(AN-AB*W,'fro')/max(1,norm(AN,'fro'));
%%*****************************************************************************