function [ quasi, seed ] = i4_sobol ( dim_num, seed )

%*****************************************************************************80
%
%% I4_SOBOL generates a new quasirandom Sobol vector with each call.
%
%  Discussion:
%
%    The routine adapts the ideas of Antonov and Saleev.
%
%    Thanks to Francis Dalaudier for pointing out that the range of allowed
%    values of DIM_NUM should start at 1, not 2!  17 February 2009.
%
%    This function was modified to use PERSISTENT variables rather than
%    GLOBAL variables, 13 December 2009.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 March 2012
%
%  Author:
%
%    Original FORTRAN77 version by Bennett Fox.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Antonov, Saleev,
%    USSR Computational Mathematics and Mathematical Physics,
%    Volume 19, 1980, pages 252 - 256.
%
%    Paul Bratley, Bennett Fox,
%    Algorithm 659:
%    Implementing Sobol's Quasirandom Sequence Generator,
%    ACM Transactions on Mathematical Software,
%    Volume 14, Number 1, pages 88-100, 1988.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%    Ilya Sobol,
%    USSR Computational Mathematics and Mathematical Physics,
%    Volume 16, pages 236-242, 1977.
%
%    Ilya Sobol, Levitan,
%    The Production of Points Uniformly Distributed in a Multidimensional
%    Cube (in Russian),
%    Preprint IPM Akad. Nauk SSSR,
%    Number 40, Moscow 1976.
%
%  Parameters:
%
%    Input, integer DIM_NUM, the number of spatial dimensions.
%    DIM_NUM must satisfy 1 <= DIM_NUM <= 40.
%
%    Input/output, integer SEED, the "seed" for the sequence.
%    This is essentially the index in the sequence of the quasirandom
%    value to be generated.  On output, SEED has been set to the
%    appropriate next value, usually simply SEED+1.
%    If SEED is less than 0 on input, it is treated as though it were 0.
%    An input value of 0 requests the first (0-th) element of the sequence.
%
%    Output, real QUASI(DIM_NUM), the next quasirandom vector.
%
  persistent atmost;
  persistent dim_max;
  persistent dim_num_save;
  persistent initialized;
  persistent lastq;
  persistent log_max;
  persistent maxcol;
  persistent poly;
  persistent recipd;
  persistent seed_save;
  persistent v;

  if ( isempty ( initialized ) )
    initialized = 0;
    dim_num_save = -1;
  end

  if ( ~initialized | dim_num ~= dim_num_save )

    initialized = 1;

    dim_max = 40;
    dim_num_save = -1;
    log_max = 30;
    seed_save = -1;
%
%  Initialize (part of) V.
%
    v(1:dim_max,1:log_max) = zeros(dim_max,log_max);

    v(1:40,1) = [ ...
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
      1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ]';

    v(3:40,2) = [ ...
            1, 3, 1, 3, 1, 3, 3, 1, ...
      3, 1, 3, 1, 3, 1, 1, 3, 1, 3, ...
      1, 3, 1, 3, 3, 1, 3, 1, 3, 1, ...
      3, 1, 1, 3, 1, 3, 1, 3, 1, 3 ]';

    v(4:40,3) = [ ...
               7, 5, 1, 3, 3, 7, 5, ...
      5, 7, 7, 1, 3, 3, 7, 5, 1, 1, ...
      5, 3, 3, 1, 7, 5, 1, 3, 3, 7, ...
      5, 1, 1, 5, 7, 7, 5, 1, 3, 3 ]';

    v(6:40,4) = [ ...
                     1, 7, 9,13,11, ...
      1, 3, 7, 9, 5,13,13,11, 3,15, ...
      5, 3,15, 7, 9,13, 9, 1,11, 7, ...
      5,15, 1,15,11, 5, 3, 1, 7, 9 ]';

    v(8:40,5) = [ ...
                           9, 3,27, ...
     15,29,21,23,19,11,25, 7,13,17, ...
      1,25,29, 3,31,11, 5,23,27,19, ...
     21, 5, 1,17,13, 7,15, 9,31, 9 ]';

    v(14:40,6) = [ ...
              37,33, 7, 5,11,39,63, ...
     27,17,15,23,29, 3,21,13,31,25, ...
      9,49,33,19,29,11,19,27,15,25 ]';

    v(20:40,7) = [ ...
                                         13, ...
     33,115, 41, 79, 17, 29,119, 75, 73,105, ...
      7, 59, 65, 21,  3,113, 61, 89, 45,107 ]';

    v(38:40,8) = [ ...
                                7, 23, 39 ]';
%
%  Set POLY.
%
    poly(1:40)= [ ...
        1,   3,   7,  11,  13,  19,  25,  37,  59,  47, ...
       61,  55,  41,  67,  97,  91, 109, 103, 115, 131, ...
      193, 137, 145, 143, 241, 157, 185, 167, 229, 171, ...
      213, 191, 253, 203, 211, 239, 247, 285, 369, 299 ];

    atmost = 2^log_max - 1;
%
%  Find the number of bits in ATMOST.
%
    maxcol = i4_bit_hi1 ( atmost );
%
%  Initialize row 1 of V.
%
    v(1,1:maxcol) = 1;

  end
%
%  Things to do only if the dimension changed.
%
  if ( dim_num ~= dim_num_save )
%
%  Check parameters.
%
    if ( dim_num < 1 | dim_max < dim_num )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'I4_SOBOL - Fatal error!\n' );
      fprintf ( 1, '  The spatial dimension DIM_NUM should satisfy:\n' );
      fprintf ( 1, '    1 <= DIM_NUM <= %d\n', dim_max );
      fprintf ( 1, '  But this input value is DIM_NUM = %d\n', dim_num );
      return
    end

    dim_num_save = dim_num;
%
%  Initialize the remaining rows of V.
%
    for i = 2 : dim_num
%
%  The bits of the integer POLY(I) gives the form of polynomial I.
%
%  Find the degree of polynomial I from binary encoding.
%
      j = poly(i);
      m = 0;

      while ( 1 )

        j = floor ( j / 2 );

        if ( j <= 0 )
          break;
        end

        m = m + 1;

      end
%
%  Expand this bit pattern to separate components of the logical array INCLUD.
%
      j = poly(i);
      for k = m : -1 : 1
        j2 = floor ( j / 2 );
        includ(k) = ( j ~= 2 * j2 );
        j = j2;
      end
%
%  Calculate the remaining elements of row I as explained
%  in Bratley and Fox, section 2.
%
      for j = m + 1 : maxcol
        newv = v(i,j-m);
        l = 1;
        for k = 1 : m
          l = 2 * l;
          if ( includ(k) )
            newv = bitxor ( newv, l * v(i,j-k) );
          end
        end
        v(i,j) = newv;
      end
    end
%
%  Multiply columns of V by appropriate power of 2.
%
    l = 1;
    for j = maxcol-1 : -1 : 1
      l = 2 * l;
      v(1:dim_num,j) = v(1:dim_num,j) * l;
    end
%
%  RECIPD is 1/(common denominator of the elements in V).
%
    recipd = 1.0 / ( 2 * l );

    lastq(1:dim_num) = 0;

  end

  seed = floor ( seed );

  if ( seed < 0 )
    seed = 0;
  end

  if ( seed == 0 )

    l = 1;
    lastq(1:dim_num) = 0;

  elseif ( seed == seed_save + 1 )
%
%  Find the position of the right-hand zero in SEED.
%
    l = i4_bit_lo0 ( seed );

  elseif ( seed <= seed_save )

    seed_save = 0;
    l = 1;
    lastq(1:dim_num) = 0;

    for seed_temp = seed_save : seed - 1
      l = i4_bit_lo0 ( seed_temp );
      for i = 1 : dim_num
        lastq(i) = bitxor ( lastq(i), v(i,l) );
      end
    end

    l = i4_bit_lo0 ( seed );

  elseif ( seed_save + 1 < seed )

    for seed_temp = seed_save + 1 : seed - 1
      l = i4_bit_lo0 ( seed_temp );
      for i = 1 : dim_num
        lastq(i) = bitxor ( lastq(i), v(i,l) );
      end
    end

    l = i4_bit_lo0 ( seed );

  end
%
%  Check that the user is not calling too many times!
%
  if ( maxcol < l )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4_SOBOL - Fatal error!\n' );
    fprintf ( 1, '  Too many calls!\n' );
    fprintf ( 1, '  MAXCOL = %d\n', maxcol );
    fprintf ( 1, '  L =      %d\n', l );
    return
  end
%
%  Calculate the new components of QUASI.
%
  for i = 1 : dim_num
    quasi(i) = lastq(i) * recipd;
    lastq(i) = bitxor ( lastq(i), v(i,l) );
  end

  seed_save = seed;
  seed = seed + 1;

  return
end


		% Se sterge spatiul de lucru
clear;
        % Stabilirea numarului de necunoscute
N=1000;
        % Se genereaza matricea coeficientilor (a)
a=rand(N);
		% Se incarca vectorul termenilor liberi b
b=randn(N,1);
        % Setarea cronometrului
t0=cputime;
        % Se rezolva sistemul de ecuatii liniare cu prima metoda prezentata
x1=a\b;
        % Se calculeaza timpul de calcul necesar
t1=cputime-t0;
        % Setarea cronometrului
t0=cputime;
        % Se rezolva sistemul de ecuatii liniare cu a doua metoda prezentata
x2=inv(a)*b;
        % Se calculeaza timpul de calcul necesar
t2=cputime-t0;
        % Se afiseaza timpii de calcul
disp('Timp de calcul metoda 1:'); disp(t1');
disp('Timp de calcul metoda 2:'); disp(t2');


function [beta_gibbs omega_gibbs F_gibbs L_gibbs phi_gibbs sigma_gibbs lambda_t_gibbs sigma_t_gibbs sbar]=tvbvar2gibbs(G,sigmahat,T,chi,psi,kappa,betahat,q,n,It,Bu,I_tau,I_om,H,Xbar,y,alpha0,yt,Xbart,upsilon0,f0,delta0,gamma,pick,pickf)

% preliminary elements for the algorithm
% compute the product G'*I_gamma*G (to speed up computations of deltabar)
GIG=G'*I_om*G;
% set tau as a large value
tau=10000;
% set omega as a large value
om=5;
% compute psibar
chibar=(chi+T)/2;
% compute alphabar
kappabar=T+kappa;
% compute alphabar
alphabar=T+alpha0;

% initiate the Gibbs sampler
% initiate the counting of iterations
count=1;
pickcount=1;
% initiate the record matrices and cells
beta_gibbs=[];
omega_gibbs=[];
F_gibbs=[];
L_gibbs=[];
phi_gibbs=[];
sigma_gibbs=[];
lambda_t_gibbs={};
sigma_t_gibbs={};

% step 1: determine initial values for the algorithm

% initial value for B
B=kron(ones(T,1),betahat);
% initial value Omega
omega=diag(diag(betahat*betahat'));
% invert Omega
invomega=diag(1./diag(omega));
% initial value for f_2,...,f_n
% obtain the triangular factorisation of sigmahat
[Fhat Lambdahat]=bear.triangf(sigmahat);
% obtain the inverse of Fhat
[invFhat]=bear.invltod(Fhat,n);
% create the cell storing the different vectors of invF
Finv=cell(n,1);
% store the vectors
for ii=2:n
    Finv{ii,1}=invFhat(ii,1:ii-1);
end
% initial values for L_1,...,L_n
L=zeros(T,n);
% initial values for phi_1,...,phi_n
phi=ones(1,n);
% initiate invsigmabar
invsigmabar=sparse(kron(eye(T),inv(sigmahat)));

% step 2: determine the sbar values and Lambda
sbar=diag(Lambdahat);
Lambda=sparse(diag(sbar));

% step 3: recover the series of initial values for lambda_1,...,lambda_T and sigma_1,...,sigma_T
lambda_t=repmat(diag(sbar),1,1,T);
sigma_t=repmat(sigmahat,1,1,T);

hbar = bear.parfor_progressbar(It,'Progress of the Gibbs sampler');  %create the progress bar

% run the Gibbs sampler
while count<=It
    % count

    hbar.iterate(1);   % update progress by one iteration

    % step 4: draw B
    invomegabar=H'*kron(I_tau,invomega)*H+Xbar'*invsigmabar*Xbar;
    % compute the choleski of invomegabar
    C=chol(bear.nspds(invomegabar),'Lower');
    % compute temporary value
    temp=Xbar'*invsigmabar*y;
    % smoothing phase: solve by back substitution
    temp1=C\temp;
    % smoothing phase: solve by forward substitution
    Bbar=C'\temp1;
    % simulation phase:
    B=Bbar+C'\randn(q*T,1);
    % reshape
    Beta=reshape(B,q,T);

    % step 5: draw omega from its posterior
    % compute the summ
    summ=(1/tau)*Beta(:,1)*Beta(:,1)';
    for ii=2:T
        summ=summ+(Beta(:,ii)-Beta(:,ii-1))*(Beta(:,ii)-Beta(:,ii-1))';
    end
    summ=diag(summ);
    % obtain Qbar
    psibar=summ+psi;
    % draw omega
    omega=diag(arrayfun(@bear.igrandn,kron(ones(q,1),chibar),psibar));
    % invert it for next iteration
    invomega=diag(1./diag(omega));

    % step 6: draw the series f_2,...,f_n from their conditional posteriors
    % recover first the residuals
    for jj=1:T
        epst(:,:,jj)=yt(:,:,jj)-Xbart{jj,1}*Beta(:,jj);
    end
    % then draw the vectors in turn
    for jj=2:n
        % first compute the summations required for upsilonbar and fbar
        summ1=zeros(jj-1,jj-1);
        summ2=zeros(jj-1,1);
        % run the summation
        for kk=1:T
            prodt=epst(1:jj-1,1,kk)*exp(-L(kk,jj));
            summ1=summ1+prodt*epst(1:jj-1,1,kk)';
            summ2=summ2+prodt*epst(jj,1,kk)';
        end
        summ1=(1/sbar(jj,1))*summ1;
        summ2=(-1/sbar(jj,1))*summ2;
        % then obtain the inverse of upsilon0
        invupsilon0=diag(1./diag(upsilon0{jj,1}));
        % obtain upsilonbar
        invupsilonbar=summ1+invupsilon0;
        C=chol(bear.nspd(invupsilonbar));
        invC=C\speye(jj-1);
        upsilonbar=full(invC*invC');
        % recover fbar
        fbar=upsilonbar*(summ2+invupsilon0*f0{jj,1});
        % finally draw f_i^(-1)
        Finv{jj,1}=fbar+chol(bear.nspd(upsilonbar),'lower')*randn(jj-1,1);
    end
    % recover the inverse of F
    invF=eye(n);
    for jj=2:n
        invF(jj,1:jj-1)=Finv{jj,1};
    end
    % eventually recover F
    F=bear.invltod(invF,n);
    % then update sigma
    sigma=F*Lambda*F';

    % step 7: draw the series phi_1,...,phi_n from their conditional posteriors
    % draw the parameters in turn
    for jj=1:n
        % estimate deltabar
        deltabar=L(:,jj)'*GIG*L(:,jj)+delta0;
        % draw the value phi_i
        phi(1,jj)=bear.igrandn(alphabar/2,deltabar/2);
    end

    % step 8: draw the series lambda_i,t from their conditional posteriors, i=1,...,n and t=1,...,T
    % consider variables in turn
    for jj=1:n
        % consider periods in turn
        for kk=1:T
            % a candidate value will be drawn from N(lambdabar,phibar)
            % the definitions of lambdabar and phibar varies with the period, thus define them first
            % if the period is the first period
            if kk==1
                lambdabar=(gamma*L(2,jj))/(1/om+gamma^2);
                phibar=phi(1,jj)/(1/om+gamma^2);
                % if the period is the final period
            elseif kk==T
                lambdabar=gamma*L(T-1,jj);
                phibar=phi(1,jj);
                % if the period is any period in-between
            else
                lambdabar=(gamma/(1+gamma^2))*(L(kk-1,jj)+L(kk+1,jj));
                phibar=phi(1,jj)/(1+gamma^2);
            end
            % now draw the candidate
            cand=lambdabar+phibar^0.5*randn;
            % compute the acceptance probability
            prob=bear.mhprob2(jj,cand,L(kk,jj),sbar(jj,1),epst(:,1,kk),Finv{jj,1});
            % draw a uniform random number
            draw=rand;
            % keep the candidate if the draw value is lower than the prob
            if draw<=prob
                L(kk,jj)=cand;
                % if not, just keep the former value
            end
        end
    end
    % then recover the series of matrices lambda_t and sigma_t
    for jj=1:T
        lambda_t(:,:,jj)=diag(sbar).*diag(exp(L(jj,:)));
        sigma_t(:,:,jj)=F*lambda_t(:,:,jj)*F';
    end

    % record phase
    % if the burn-in sample phase is not yet over
    if count<=Bu
        % simply add 1 to the iteration count
        count=count+1;
        % on the other hand, if the burn-in sample phase is over
    elseif count>Bu
        % adding one iteration to the count will depend on wether post-burn selection applies
        % if there is no post burn selection
        if pick==0
            % record the results
            beta_gibbs(:,count-Bu)=B;
            omega_gibbs(:,count-Bu)=diag(omega);
            F_gibbs(:,:,count-Bu)=F;
            L_gibbs(:,:,count-Bu)=L;
            phi_gibbs(count-Bu,:)=phi;
            sigma_gibbs(:,count-Bu)=sigma(:);
            for jj=1:T
                lambda_t_gibbs{jj,1}(:,:,count-Bu)=lambda_t(:,:,jj);
                sigma_t_gibbs{jj,1}(:,:,count-Bu)=sigma_t(:,:,jj);
            end
            % then add one to the count
            count=count+1;
            % if there is post burn selection, only one draw over 'fpick' draws will be retained
        elseif pick==1
            % if the iteration does not correspond to fpick, don't record the results, don't increase the regular count, but do increase pickcount by 1, and do record the acceptance rate of the Metropolis-Hastings step
            if pickcount~=pickf
                pickcount=pickcount+1;
                % on the other hand, if the iteration does correspond to fpick
            elseif pickcount==pickf
                % do record the results
                beta_gibbs(:,count-Bu)=B;
                omega_gibbs(:,count-Bu)=diag(omega);
                F_gibbs(:,:,count-Bu)=F;
                L_gibbs(:,:,count-Bu)=L;
                phi_gibbs(count-Bu,:)=phi;
                sigma_gibbs(:,count-Bu)=sigma(:);
                for jj=1:T
                    lambda_t_gibbs{jj,1}(:,:,count-Bu)=lambda_t(:,:,jj);
                    sigma_t_gibbs{jj,1}(:,:,count-Bu)=sigma_t(:,:,jj);
                end
                % then increase the regular count by 1 and re-initialise pickcount
                count=count+1;
                pickcount=1;
            end
        end
    end
end
close(hbar);   %close progress bar

% turn beta_gibbs into cell
beta_gibbs=mat2cell(beta_gibbs,repmat(q,T,1),It-Bu);


function [cst,cstJac] = autoGen_cst_footVel(q1p,q2p,q4p,q5p,q1m,q2m,q4m,q5m,dq1p,dq2p,dq4p,dq5p,dq1m,dq2m,dq4m,dq5m,l1,l2,l4,l5)
%AUTOGEN_CST_FOOTVEL
%    [CST,CSTJAC] = AUTOGEN_CST_FOOTVEL(Q1P,Q2P,Q4P,Q5P,Q1M,Q2M,Q4M,Q5M,DQ1P,DQ2P,DQ4P,DQ5P,DQ1M,DQ2M,DQ4M,DQ5M,L1,L2,L4,L5)

%    This function was generated by the Symbolic Math Toolbox version 6.3.
%    25-Oct-2015 18:36:52

t2 = sin(q1p);
t3 = sin(q2p);
t4 = sin(q4p);
t5 = sin(q5p);
t6 = sin(q1m);
t7 = sin(q2m);
t8 = sin(q4m);
t9 = sin(q5m);
cst = [dq1p.*l1.*t2+dq2p.*l2.*t3-dq4p.*l4.*t4-dq5p.*l5.*t5;-dq1m.*l1.*t6-dq2m.*l2.*t7+dq4m.*l4.*t8+dq5m.*l5.*t9];
if nargout > 1
    cstJac = reshape([0.0,0.0,dq1p.*l1.*cos(q1p),0.0,dq2p.*l2.*cos(q2p),0.0,0.0,0.0,-dq4p.*l4.*cos(q4p),0.0,-dq5p.*l5.*cos(q5p),0.0,l1.*t2,0.0,l2.*t3,0.0,0.0,0.0,-l4.*t4,0.0,-l5.*t5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,-dq1m.*l1.*cos(q1m),0.0,-dq2m.*l2.*cos(q2m),0.0,0.0,0.0,dq4m.*l4.*cos(q4m),0.0,dq5m.*l5.*cos(q5m),0.0,-l1.*t6,0.0,-l2.*t7,0.0,0.0,0.0,l4.*t8,0.0,l5.*t9,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0],[2,32]);
end


function writeGrid(filename, grid_size, grid_spacing, pml_size, pml_alpha, Nt, dt, c_ref)
%WRITEGRID    Write grid and PML properties to a k-Wave HDF5 file.
%
% DESCRIPTION:
%       writeGrid creates and writes the wavenumber grids and PML variables
%       required by the k-Wave C++ code to the HDF5 file specified by the
%       user.
%
%       List of parameters that are written:
%           Nx
%           Ny
%           Nz
%           Nt
%           dt
%           dx
%           dy
%           dz
%           c_ref
%           ddx_k_shift_pos_r
%           ddx_k_shift_neg_r
%           ddy_k_shift_pos
%           ddy_k_shift_neg
%           ddz_k_shift_pos
%           ddz_k_shift_neg
%           x_shift_neg_r
%           y_shift_neg_r
%           z_shift_neg_r
%           pml_x_sgx
%           pml_y_sgy
%           pml_z_sgz
%           pml_x
%           pml_y
%           pml_z
%           pml_x_alpha
%           pml_y_alpha
%           pml_z_alpha
%           pml_x_size
%           pml_y_size
%           pml_z_size
%
% USAGE:
%       writeGrid(filename, grid_size, grid_spacing, pml_size, pml_alpha, Nt, dt, c_ref)
%
% INPUTS:
%       filename            - filename and location of the input HDF5 file
%       grid_size           - [Nx, Ny, Nz]
%       grid_spacing        - [dx, dy, dz]
%       pml_size            - [pml_x_size, pml_y_size, pml_z_size]
%       pml_alpha           - [pml_x_alpha, pml_y_alpha, pml_z_alpha]
%       Nt                  - number of time points
%       dt                  - time step
%       c_ref               - scalar sound speed used in the k-space
%                             operator and to define the pml variables
%
% ABOUT:
%       author              - Bradley Treeby
%       date                - 30th May 2013
%       last update         - 21st August 2014
%
% This function is part of the k-Wave Toolbox (http://www.k-wave.org)
% Copyright (C) 2009-2014 Bradley Treeby and Ben Cox
%
% See also h5writeatt, writeAttributes, writeFlags, writeMatrix

% This file is part of k-Wave. k-Wave is free software: you can
% redistribute it and/or modify it under the terms of the GNU Lesser
% General Public License as published by the Free Software Foundation,
% either version 3 of the License, or (at your option) any later version.
%
% k-Wave 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 Lesser General Public License for
% more details.
%
% You should have received a copy of the GNU Lesser General Public License
% along with k-Wave. If not, see <http://www.gnu.org/licenses/>.

%#ok<*INUSL>
%#ok<*NASGU>

% get literals
getH5Literals;

% unpack grid size inputs to make code easier to read
Nx          = grid_size(1);
Ny          = grid_size(2);
Nz          = grid_size(3);
dx          = grid_spacing(1);
dy          = grid_spacing(2);
dz          = grid_spacing(3);
pml_x_size  = pml_size(1);
pml_y_size  = pml_size(2);
pml_z_size  = pml_size(3);
pml_x_alpha = pml_alpha(1);
pml_y_alpha = pml_alpha(2);
pml_z_alpha = pml_alpha(3);

% =========================================================================
% CREATE WAVENUMBER AND PML VECTORS
% =========================================================================

% create the wavenumber grids (assuming Nx, Ny and Nz are even)
nx = ((-Nx/2:Nx/2-1)/Nx).';
nx(floor(Nx/2) + 1) = 0;
kx_vec = (2*pi/dx).*nx;

ny = ((-Ny/2:Ny/2-1)/Ny).';
ny(floor(Ny/2) + 1) = 0;
ky_vec = (2*pi/dy).*ny;

nz = ((-Nz/2:Nz/2-1)/Nz).';
nz(floor(Nz/2) + 1) = 0;
kz_vec = (2*pi/dz).*nz;

% force the vector operators be in the correct direction (Nx, 1, 1), (1, Ny, 1), (1, 1, Nz)
ky_vec = ky_vec.';
kz_vec = permute(kz_vec, [2 3 1]);

% create vector derivative and shift variables
ddx_k_shift_pos = ifftshift( 1i*kx_vec .* exp( 1i*kx_vec*dx/2), 1);
ddx_k_shift_neg = ifftshift( 1i*kx_vec .* exp(-1i*kx_vec*dx/2), 1);
ddy_k_shift_pos = ifftshift( 1i*ky_vec .* exp( 1i*ky_vec*dy/2), 2);
ddy_k_shift_neg = ifftshift( 1i*ky_vec .* exp(-1i*ky_vec*dy/2), 2);
ddz_k_shift_pos = ifftshift( 1i*kz_vec .* exp( 1i*kz_vec*dz/2), 3);
ddz_k_shift_neg = ifftshift( 1i*kz_vec .* exp(-1i*kz_vec*dz/2), 3);

% create vector shift operators
x_shift_neg = ifftshift( exp(-1i*kx_vec*dx/2), 1);
y_shift_neg = ifftshift( exp(-1i*ky_vec*dy/2), 2);
z_shift_neg = ifftshift( exp(-1i*kz_vec*dz/2), 3);

% create reduced variables for use with real-to-complex FFT
Nx_r                    = floor(Nx/2) + 1;
Ny_r                    = floor(Ny/2) + 1;
Nz_r                    = floor(Nz/2) + 1;
ddx_k_shift_pos_r       = ddx_k_shift_pos(1:Nx_r);
ddx_k_shift_neg_r       = ddx_k_shift_neg(1:Nx_r);
x_shift_neg_r           = x_shift_neg(1:Nx_r);
y_shift_neg_r           = y_shift_neg(1:Ny_r);
z_shift_neg_r           = z_shift_neg(1:Nz_r);

% create vector PML variables
pml_x       = getPML(Nx, dx, dt, c_ref, pml_x_size, pml_x_alpha, false, 1);
pml_x_sgx   = getPML(Nx, dx, dt, c_ref, pml_x_size, pml_x_alpha, true,  1);
pml_y       = getPML(Ny, dy, dt, c_ref, pml_y_size, pml_y_alpha, false, 2);
pml_y_sgy   = getPML(Ny, dy, dt, c_ref, pml_y_size, pml_y_alpha, true,  2);
pml_z       = getPML(Nz, dz, dt, c_ref, pml_z_size, pml_z_alpha, false, 3);
pml_z_sgz   = getPML(Nz, dz, dt, c_ref, pml_z_size, pml_z_alpha, true,  3);

% cleanup unused variables
clear ddx_k_shift_pos ddx_k_shift_neg x_shift_neg y_shift_neg z_shift_neg;

% =========================================================================
% STORE FLOATS
% =========================================================================

% list of variables stored as floats
variable_names = {...
    'dt', 'dx', 'dy', 'dz', ...
    'ddx_k_shift_pos_r', 'ddx_k_shift_neg_r', 'x_shift_neg_r', ...
    'ddy_k_shift_pos',   'ddy_k_shift_neg',   'y_shift_neg_r', ...
    'ddz_k_shift_pos',   'ddz_k_shift_neg',   'z_shift_neg_r', ...
    'pml_x_sgx',   'pml_y_sgy',   'pml_z_sgz', ...
    'pml_x',       'pml_y',       'pml_z', ...
    'pml_x_alpha', 'pml_y_alpha', 'pml_z_alpha', ...
    'c_ref'};

% change float variables to be in single precision (float in C++), then
% add to HDF5 file
for index = 1:length(variable_names)

    % cast matrix to single precision
    eval([variable_names{index} ' = ' MATRIX_DATA_TYPE_MATLAB '(' variable_names{index} ');']);

    % write to HDF5 file
    writeMatrix(filename, eval(variable_names{index}), variable_names{index});

end

% =========================================================================
% STORE INTEGERS
% =========================================================================

% integer variables
variable_names = {'Nx', 'Ny', 'Nz', 'Nt',...
    'pml_x_size' , 'pml_y_size' , 'pml_z_size'};

% change all the index variables to be in 64-bit unsigned integers (long in C++)
for index = 1:length(variable_names)

    % cast matrix to 64-bit unsigned integer
    eval([variable_names{index} ' = ' INTEGER_DATA_TYPE_MATLAB '(' variable_names{index} ');']);

    % write to HDF5 file
    writeMatrix(filename, eval(variable_names{index}), variable_names{index});

end


function [ kn, fn, wn ] = r4_nor_setup ( )

%*****************************************************************************80
%
%% R4_NOR_SETUP sets data needed by R4_NOR.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 October 2013
%
%  Author:
%
%    Original C version by George Marsaglia, Wai Wan Tsang
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    George Marsaglia, Wai Wan Tsang,
%    The Ziggurat Method for Generating Random Variables,
%    Journal of Statistical Software,
%    Volume 5, Number 8, October 2000, seven pages.
%
%  Parameters:
%
%    Output, uint32 KN(128), data needed by R4_NOR.
%
%    Output, real FN(128), WN(128), data needed by R4_NOR.
%
  kn = zeros ( 128, 'uint32' );
  fn = zeros ( 128 );
  wn = zeros ( 128 );

  m1 = 2147483648.0;
  vn = 9.91256303526217E-03;

  dn = 3.442619855899;
  tn = 3.442619855899;

  q = vn / exp ( - 0.5 * dn * dn );
  kn(1) = uint32 ( ( dn / q ) * m1 );
  kn(2) = 0;

  wn(1) = q / m1;
  wn(128) = dn / m1;

  fn(1) = 1.0;
  fn(128) = exp ( - 0.5 * dn * dn );

  for i = 127 : -1 : 2
    dn = sqrt ( - 2.0 * log ( vn / dn + exp ( - 0.5 * dn * dn ) ) );
    kn(i+1) = uint32 ( ( dn / tn ) * m1 );
    tn = dn;
    fn(i) = exp ( - 0.5 * dn * dn );
    wn(i) = dn / m1;
  end

  return
end


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

function X = construct_initial_guess(L, F, r, n)
% Basicially only the first micro-step of ALS

X = TTeMPS_rand( r, n );
X = 1/norm(X) * X;

d = X.order;
n = X.size;

X = orthogonalize(X, 1);
Fi = contract( X, F, 1 );
sz = [X.rank(1), X.size(1), X.rank(2)];

[left, right] = Afun_prepare( L, X, 1 );
B1 =  prepare_precond( L.A{1}, X, 1 );

Ui = pcg( @(y) Afun( L, y, 1, sz, left, right), ...
         Fi(:), ...
         1e-10, 1000, ...
         @(y) apply_precond( L.A{1}, B1, y, sz ), [],...
         X.U{1}(:) );

X.U{1} = reshape( Ui, sz );

X = orth_at( X, 1, 'left', true );

end

function [left, right] = Afun_prepare( A, x, idx )
    y = A.apply(x);
    if idx == 1
        right = innerprod( x, y, 'RL', idx+1 );
        left = [];
    elseif idx == x.order
        left = innerprod( x, y, 'LR', idx-1 );
        right = [];
    else
        left = innerprod( x, y, 'LR', idx-1 );
        right = innerprod( x, y, 'RL', idx+1 );
    end
end

function res = Afun( A, U, idx, sz, left, right )

    V = reshape( U, sz );
    V = A.apply( V, idx );

    if idx == 1
        tmp = tensorprod_ttemps( V, right, 3 );
    elseif idx == A.order
        tmp = tensorprod_ttemps( V, left, 1 );
    else
        tmp = tensorprod_ttemps( V, right, 3);
        tmp = tensorprod_ttemps( tmp, left, 1);
    end

    res = tmp(:);
end

function B1 = prepare_precond( L0, X, idx )

    if idx == 1
        B1 = [];
        return
    end

    n = size(L0, 1);
    r = X.rank;

    X1 = matricize( X.U{1}, 2);
    Y = X;
    Y.U{1} = tensorize( L0*X1, 2, [r(1), n(1), r(2)] );
    B1 = innerprod( X, Y, 'LR', idx-1);
end

function res = apply_precond( L0, B1, rhs, sz )

    n = size(L0, 1);
    rhs = reshape( rhs, sz );
    if isempty(B1) %idx == 1
        res = L0 \ unfold( rhs, 'left' );
        res = reshape( res, sz );
    else
        res = B1 \ unfold(rhs, 'right');
        res = reshape( res, sz );
    end
    res = res(:);
end


function rs = realifft(data, N)

% inverse fft for fourier coefficents from real valued  original data
% needs the length of the original time series from which the fft was computed
% see also : realfft

data = data(:);
if mod(N,2) 	% odd length
	data = [data ; conj(data(end:-1:2))];
else			% even length
	data = [data ; conj(data(end-1:-1:2))];
end

rs = real(ifft(data)); % remove small imaginary components introduced by rounding errors


% =========================================================================
% This code is part of the Matlab-based toolbox
% LagLDDDM - A Lagrangian Gauss--Newton--Krylov Solver for Mass- and
%                        Intensity-Preserving Diffeomorphic Image Registration
%
% For details and license info see
% - https://github.com/C4IR/FAIR.m/tree/master/add-ons/LagLDDMM
%
% 2D Multilevel Mass-Preserving LDDMM Example using stationary velocity
% field and diffusion regularizer as described in Sec. 4 of the paper:
%
% @article{MangRuthotto2017,
%   Title = {A {L}agrangian {G}auss--{N}ewton--{K}rylov solver for mass- and intensity-preserving diffeomorphic image registration},
%   Year = {2017},
%   Journal = {SIAM Journal on Scientific Computing},
%   Author = {A. Mang, L. Ruthotto},
% }
%
% =========================================================================
close all; clc; clear all;
setup3DmouseData;
alpha = [50 0];
lvl = 4;
pad = 0;
mV = @(m) m;
nt = 0;
N  = 2;
minLevel = 4;
maxLevel = 6;
imgModel('reset','imgModel','linearInterMex')
% 1) setup grid for velocities (padded)
omegaV = omega; omegaV(1:2:end) = omegaV(1:2:end)-pad;  omegaV(2:2:end) = omega(2:2:end)+pad;

% 2) setup regularizer (and decide for stationary or nonstationary velocity)
regularizer('reset','regularizer','mfDiffusionCC','alpha',alpha,'nt',nt,'HessianShift',1e-2); % nonstationary velocity

%%
plots = 1;
NPIRpara    = optPara('NPIR-GN');
NPIRpara.maxIter = 40;
NPIRpara.scheme = @GaussNewtonLDDMM;

[vc,~,wc,his] = MLLDDMM(ML,'minLevel',minLevel,'maxLevel',maxLevel,'omegaV',omegaV,...
    'mV',mV,'N',N,'parametric',0,'plots',plots,'NPIRpara',NPIRpara,'NPIRobj',@MPLDDMMobjFctn);
switch regularizer
    case {'mfDiffusionST','mfCurvatureST'}
        yInv = getTrafoFromInstationaryVelocityRK4(vc,getNodalGrid(omega,m),'omega',omegaV,'m',m,'N',N,'nt',nt,'tspan',[1 0]);
    case {'mfDiffusionCC','mfCurvatureCC'}
        yInv = getTrafoFromVelocityRK4(vc,getNodalGrid(omega,m),'omega',omegaV,'m',m,'N',N,'tspan',[1 0]);
        nt = 0;
end

%%
yc = getTrafoFromVelocityRK4(vc,getNodalGrid(omega,m),'omega',omegaV,'m',m,'nt',nt,'tspan',[1,0],'N',N);
Jac = geometry(yInv,m,'Jac','omega',omega);
Topt = linearInterMex(dataT,omega,center(yInv,m)) .* Jac;
D0  = distance(dataT(:),dataR(:),omega,m);
DOpt = distance(Topt(:),dataR(:),omega,m);

fig = figure(); clf;
fig.Name = sprintf('Results for %s',mfilename);

subplot(2,3,1);
viewImage(dataR,omega,m);
title('reference');

subplot(2,3,4);
viewImage(dataT,omega,m);
title('template');

subplot(2,3,2);
viewImage(Topt,omega,m);
title('T(yc)')

subplot(2,3,3);
imgmontage(dataT(:)-dataR(:),omega,m);
title('init. residual, SSD=100%');

subplot(2,3,5);
imgmontage(Jac,omega,m);
title(sprintf('Jac, min=%1.2f max=%1.2f',min(Jac(:)),max(Jac(:))));

subplot(2,3,6);
imgmontage(Topt(:)-dataR(:),omega,m);
title(sprintf('opt residual, SSD=%1.2f%%',100*DOpt/D0));


function [PC,CC,DC,IC] = trim_with_spline(PA,CA,PB,CB,tol)
  % TRIM_WITH_SPLINE Trim a given spline (PA,CA) with a "solid" spline (PB,CB)
  %
  % [PC,CC,DC,IC] = trim_with_spline(PA,CA,PB,CB,tol)
  %
  % Inputs:
  %   PA  #PA by dim list of control point locations
  %   CA  #CA by 4 list of indices into PA of cubic Bezier curves
  %   PB  #PB by dim list of control point locations
  %   CB  #CB by 4 list of indices into PB of cubic Bezier curves
  %   tol  tolerance for intersection {1e-7}
  % Outputs:
  %   PC  #PC by dim list of control point locations
  %   CC  #CC by 4 list of indices into PC of cubic Bezier curves
  %   DC  #CC list of flags whether inside B
  %   IC  #CC list of indices into CA
  %

  function [PA,CA,DA,IA] = trim_with_spline_helper(PA,CA,PB,CB)

    [A1,A2] = box_each_element(PA,CA);
    [B1,B2] = box_each_element(PB,CB);
    I = box_intersect(A1,A2,B1,B2);
    T = cell(size(CA,1),1);
    % consider each intersection, gather splits
    for ii = 1:size(I,1)
      ca = I(ii,1);
      cb = I(ii,2);
      Tii = cubic_cubic_intersect(PA(CA(ca,:),:),PB(CB(cb,:),:),tol);
      if ~isempty(Tii)
        T{ca} = [T{ca};Tii(:,1)];
      end
    end
    % conduct all splits
    IA = (1:size(CA,1))';
    for ca = 1:size(CA,1)
      if ~isempty(T{ca})
        Tca = sort(T{ca});
        [PAa,CAa] = cubic_subdivide(PA(CA(ca,:),:),Tca);
        CAa = reshape([CA(ca,1) CAa(2:end-1)+size(PA,1)-2 CA(ca,end)],size(CAa));
        IA([ca size(CA,1)+(1:size(CAa,1)-1)],:) = IA(ca);
        CA([ca size(CA,1)+(1:size(CAa,1)-1)],:) = CAa;
        PA = [PA;PAa(3:end,:)];
      end
    end

    %%fprintf('trim_with_spline...\n');
    %% loop order is imporant
    %IA = (1:size(CA,1))';
    %for cb = 1:size(CB,1)
    %  %fprintf('  %04d/%04d:\n',cb,size(CB,1));
    %  for ca = 1:size(CA,1)
    %    %progressbar(ca,size(CA,1));
    %    T = cubic_cubic_intersect(PA(CA(ca,:),:),PB(CB(cb,:),:),tol);
    %    if ~isempty(T)
    %      [PAa,CAa] = cubic_subdivide(PA(CA(ca,:),:),T(:,1));
    %      CAa = reshape([CA(ca,1) CAa(2:end-1)+size(PA,1)-2 CA(ca,end)],size(CAa));
    %      IA([ca size(CA,1)+(1:size(CAa,1)-1)],:) = IA(ca);
    %      CA([ca size(CA,1)+(1:size(CAa,1)-1)],:) = CAa;
    %      PA = [PA;PAa(3:end,:)];
    %    end
    %  end
    %end

    % midpoints of each cubic
    %fprintf('midpoints...\n');
    M = zeros(size(CA,1),2);
    for ca = 1:size(CA,1)
      M(ca,:) = cubic_eval(PA(CA(ca,:),:),0.5);
    end
    %fprintf('spline_winding_number...\n');
    DA = abs(spline_winding_number(PB,CB,M))>0.5;
  end

  m = size(CA,1);
  embed = @(P,C) reshape(P(C,:),size(C,1),8);
  CB8 = embed(PB,CB);
  % In either direction
  RB8 = embed(PB,fliplr(CB));
  CA8 = embed(PA,CA);
  % find perfect matches (only considering that every control point is exactly
  % the same; not finding partial co-incidence )
  [idx,dist] = rangesearch([CB8;RB8],CA8,0);
  perfect = cellfun(@(i) ~isempty(i),idx);
  JN = find(~perfect);
  [PA,CN,DN,IN] = trim_with_spline_helper(PA,CA(JN,:),PB,CB);
  CA = [CN;CA(perfect,:)];
  JP = find(perfect);
  IA = [JN(IN);JP];
  DA = [DN;true(numel(JP),1)];
  assert(size(CA,1) == numel(IA));
  assert(max(IA) <= m);
  assert(size(CA,1) == numel(DA));

  % rename
  PC = PA;
  CC = CA;
  DC = DA;
  IC = IA;
end


function label = LSC(data,k,opts)
% label = LSC(data,k,opts): Landmark-based Spectral Clustering
% Input:
%       - data: the data matrix of size nSmp x nFea, where each row is a sample
%               point
%       - k: the number of clusters
%       opts: options for this algorithm
%           - p: the number of landmarks picked (default 1000)
%           - r: the number of nearest landmarks for representation (default 5)
%           - numRep: the number of replicates for the final kmeans (default 10)
%           - maxIter: the maximum number of iterations for final kmeans (default 100)
%           - mode: landmark selection method, currently support
%               - 'kmeans': use centers of clusters generated by kmeans (default)
%               - 'random': use randomly sampled points from the original
%                           data set
%           The following parameters are effective ONLY in mode 'kmeans'
%           - kmNumRep: the number of replicates for initial kmeans (default 1)
%           - kmMaxIter: the maximum number of iterations for initial kmeans (default 5)
% Output:
%       - label: the cluster assignment for each point
% Requre:
%       litekmeans.m
% Usage:
%       data = rand([100,50]);
%       label = LSC(data,10);
%Reference:
%
%	[1] Xinlei Chen, Deng Cai, "Large Scale Spectral Clustering with
%	Landmark-Based Representation," AAAI 2011.
%
%   [2] Deng Cai, Xinlei Chen: Large Scale Spectral Clustering Via
%   Landmark-Based Sparse Representation. IEEE Trans. Cybernetics 45(8):
%   1669-1680 (2015)
%
%   version 2.0 --Dec./2011
%   version 1.0 --Oct./2010
%
%   Written by Xinlei Chen (endernewton AT gmail.com)
%              Deng Cai (dengcai AT gmail.com)

% Set and parse parameters
if (~exist('opts','var'))
   opts = [];
end

p = 1000;
if isfield(opts,'p')
    p = opts.p;
end

r = 5;
if isfield(opts,'r')
    r = opts.r;
end

maxIter = 100;
if isfield(opts,'maxIter')
    maxIter = opts.maxIter;
end

numRep = 10;
if isfield(opts,'numRep')
    numRep = opts.numRep;
end

mode = 'kmeans';
if isfield(opts,'mode')
    mode = opts.mode;
end

nSmp=size(data,1);

% Landmark selection
if strcmp(mode,'kmeans')
    kmMaxIter = 5;
    if isfield(opts,'kmMaxIter')
        kmMaxIter = opts.kmMaxIter;
    end
    kmNumRep = 1;
    if isfield(opts,'kmNumRep')
        kmNumRep = opts.kmNumRep;
    end
    [~,marks]=litekmeans(data,p,'MaxIter',kmMaxIter,'Replicates',kmNumRep);
    clear kmMaxIter kmNumRep
elseif strcmp(mode,'random')
    indSmp = randperm(nSmp);
    marks = data(indSmp(1:p),:);
    clear indSmp
else
    error('mode does not support!');
end

% Z construction
D = EuDist2(data,marks);

if isfield(opts,'sigma')
    sigma = opts.sigma;
else
    sigma = mean(mean(D));
end

dump = zeros(nSmp,r);
idx = dump;
for i = 1:r
    [dump(:,i),idx(:,i)] = min(D,[],2);
    temp = (idx(:,i)-1)*nSmp+[1:nSmp]';
    D(temp) = 1e100;
end

dump = exp(-dump/(2*sigma^2));
sumD = sum(dump,2);
Gsdx = bsxfun(@rdivide,dump,sumD);
Gidx = repmat([1:nSmp]',1,r);
Gjdx = idx;
Z=sparse(Gidx(:),Gjdx(:),Gsdx(:),nSmp,p);

% Graph decomposition
feaSum = full(sqrt(sum(Z,1)));
feaSum = max(feaSum, 1e-12);
Z = Z./feaSum(ones(size(Z,1),1),:);
U = mySVD(Z,k+1);
U(:,1) = [];

U=U./repmat(sqrt(sum(U.^2,2)),1,k);

% Final kmeans
label=litekmeans(U,k,'MaxIter',maxIter,'Replicates',numRep);


function [y1, y2] = vl_nnpdist(x, x0, p, varargin)
%VL_NNPDIST CNN p-distance from target.
%   VL_NNPDIST(X, X0, P) computes the P distance raised of each feature
%   vector in X to the corresponding feature vector in X0:
%
%     Y(i,j,1) = (SUM_d (X(i,j,d) - X0(i,j,d))^P)^(1/P)
%
%   X0 should have the same size as X; the outoput Y has the same
%   height and width as X, but depth equal to 1. Optionally, X0 can
%   be a 1 x 1 x D x N array, in which case the same target feature
%   vector in X0 is compared to all feature vectors in X. In that case,
%   however, the DZDX0 are of size of X.
%
%   Setting the `noRoot` option to `true` does not take the 1/P power
%   in the formula, computing instead
%
%     Y(i,j,1) = SUM_d (X(i,j,d) - X0(i,j,d))^P
%
%   For example, `vl_nnpdist(x, x0, 2, 'noRoot', true)` computes the
%   squared L2 distance.
%
%   [DZDX, DZDX0] = VL_NNPDISTP(X, X0, P, DZDY) computes the derivative
%   of the block inputs projected onto DZDY. DZDX, DZDX0 and DZDY have the
%   same dimensions as X and Y, respectively.
%
%   VL_NNPDIST(___, 'OPT', VAL, ...) accepts the following options:
%
%   `NoRoot`:: `false`
%      If set to true, compute the P-distance to the P-th power.
%
%   `Epsilon`:: 1e-6
%      When computing derivatives, quantities that are divided in are
%      lower boudned by this value. For example, the L2 distance is
%      not smooth at the origin; this option prevents the
%      derivative from diverging.
%
%   `Aggregate`:: false
%      Instead of returning one scalar for each spatial location in
%      the inputs, sum all of them into a single scalar.
%
%   `InstanceWeights``:: `[]`
%      Optionally weight individual instances. This parameter can be
%      eigther a scalar or a weight mask, one for each pixel in the
%      input tensor.

% Copyright (C) 2015  Karel Lenc and Andrea Vedaldi.
% All rights reserved.
%
% This file is part of the VLFeat library and is made available under
% the terms of the BSD license (see the COPYING file).

% -------------------------------------------------------------------------
%                                                             Parse options
% -------------------------------------------------------------------------

opts.noRoot = false ;
opts.epsilon = 1e-6 ;
opts.aggregate = false ;
opts.instanceWeights = [] ;
backMode = numel(varargin) > 0 && ~ischar(varargin{1}) ;
if backMode
  dzdy = varargin{1} ;
  opts = vl_argparse(opts, varargin(2:end), 'nonrecursive') ;
else
  dzdy = [] ;
  opts = vl_argparse(opts, varargin, 'nonrecursive') ;
end

% -------------------------------------------------------------------------
%                                                             Parse options
% -------------------------------------------------------------------------

d = bsxfun(@minus, x, x0) ;

if ~isempty(dzdy) && ~isempty(opts.instanceWeights)
  dzdy = bsxfun(@times, opts.instanceWeights, dzdy) ;
end

if ~opts.noRoot
  if isempty(dzdy)
    if p == 1
      y1 = sum(abs(d),3) ;
    elseif p == 2
      y1 = sqrt(sum(d.*d,3)) ;
    else
      y1 = sum(abs(d).^p,3).^(1/p) ;
    end
  else
    if p == 1
      y1 = bsxfun(@times, dzdy, sign(d)) ;
    elseif p == 2
      y1 = max(sum(d.*d,3), opts.epsilon).^(-0.5) ;
      y1 = bsxfun(@times, bsxfun(@times, dzdy, y1),  d) ;
    elseif p < 1
      y1 = sum(abs(d).^p,3).^((1-p)/p) ;
      y1 = bsxfun(@times, bsxfun(@times, dzdy, y1), max(abs(d), opts.epsilon).^(p-1) .* sign(d)) ;
    else
      y1 = max(sum(abs(d).^p,3), opts.epsilon).^((1-p)/p) ;
      y1 = bsxfun(@times, bsxfun(@times, dzdy, y1), abs(d).^(p-1) .* sign(d)) ;
    end
  end
else
  if isempty(dzdy)
    if p == 1
      y1 = sum(abs(d),3) ;
    elseif p == 2
      y1 = sum(d.*d,3) ;
    else
      y1 = sum(abs(d).^p,3) ;
    end
  else
    if p == 1
      y1 = bsxfun(@times, dzdy, sign(d)) ;
    elseif p == 2
      y1 = bsxfun(@times, 2 * dzdy, d) ;
    elseif p < 1
      y1 = bsxfun(@times, p * dzdy, max(abs(d), opts.epsilon).^(p-1) .* sign(d)) ;
    else
      y1 = bsxfun(@times, p * dzdy, abs(d).^(p-1) .* sign(d)) ;
    end
  end
end

if isempty(dzdy)
  if ~isempty(opts.instanceWeights)
    y1 = bsxfun(@times, opts.instanceWeights, y1) ;
  end
  if opts.aggregate
    y1 = sum(sum(y1)) ;
  end
end
if ~isempty(dzdy), y2 = -y1; end


%PARZENC Optimisation of the Parzen classifier
%
%  [W,H] = PARZENC(A,H)
%  [W,H] = A*PARZENC([],H)
%  [W,H] = A*PARZENC(H)
%
% INPUT
%  A    dataset
%  H    smoothing parameter (may be scalar, vector of per-class
%       parameters, or matrix with parameters for each class (rows) and
%       dimension (columns))
%
% OUTPUT
%  W    trained mapping
%  H    estimated smoothing (scalar value)
%
% DESCRIPTION
% Computation of the optimum smoothing parameter H for the Parzen
% classifier between the classes in the dataset A. The leave-one-out
% Lissack & Fu estimate is used for the classification error E. The
% final classifier is stored as a mapping in W. It may be converted
% into a classifier by W*CLASSC. PARZENC cannot be used for density
% estimation.
%
% In case smoothing H is specified, no learning is performed, just the
% discriminant W is produced for the given smoothing parameters H.
% Smoothing parameters may be scalar, vector of per-class parameters, or
% a matrix with individual smoothing for each class (rows) and feature
% directions (columns)
%
% EXAMPLES
% See PREX_DENSITY for densities and PREX_PARZEN for differences between
% PARZENC, PARZENDC and PARZENM.
%
% REFERENCES
% T. Lissack and K.S. Fu, Error estimation in pattern recognition via
% L-distance between posterior density functions, IEEE Trans. Inform.
% Theory, vol. 22, pp. 34-45, 1976.
%
% SEE ALSO (PRTools Guide)
% DATASETS, MAPPINGS, PARZEN_MAP, PARZENML, PARZENDC, PARZENM, CLASSC,
% PREX_PARZEN

% Copyright: R.P.W. Duin, r.p.w.duin@37steps.com
% Faculty EWI, Delft University of Technology
% P.O. Box 5031, 2600 GA Delft, The Netherlands

% $Id: parzenc.m,v 1.6 2008/07/03 09:11:44 duin Exp $

function [W,h] = parzenc(varargin)

	mapname = 'ParzenC';
  argin = shiftargin(varargin,'scalar');
  argin = setdefaults(argin,[],[]);

  if mapping_task(argin,'definition')
    W = define_mapping(argin,'untrained',mapname);

  elseif mapping_task(argin,'training')			% Train a mapping.

    [a,h] = deal(argin{:});
    islabtype(a,'crisp','soft');
    isvaldfile(a,2,2); % at least 2 objects per class, 2 classes
    a = testdatasize(a);
    a = testdatasize(a,'objects');

    [m,k,c] = getsize(a);
    nlab = getnlab(a);

    if ~isempty(h)       % take user setting for smoothing parameter

      if size(h,1) == 1, h = repmat(h,c,1); end
      if size(h,2) == 1, h = repmat(h,1,k); end
      if any(size(h) ~= [c,k])
        error('Array with smoothing parameters has wrong size');
      end
      W = prmapping('parzen_map','trained',{a,h},getlablist(a),k,c);
      W = setname(W,'Parzen Classifier');
      return

    end

    % compute all object distances
    % make diagonal inf to exclude objects own contribution
    D = +distm(a) + diag(inf*ones(1,m));

    % find object frequencies
    if islabtype(a,'crisp')
      csize = classsizes(a);
      of = csize(nlab);
    else
      csize = sum(gettargets(a),1);
    end

    % find object weights q
    p = getprior(a);
    a = setprior(a,p);
    q = p(nlab)./csize(nlab);

    % initialise
    h = max(std(a)); % for sure a too high value
    L = -inf;
    Ln = 0;
    z = 0.1^(1/k); % initial step size

    % iterate

    iter = 0;
    prwaitbar(100,'parzenc: Optimizing smoothing parameter',m > 100);
    while abs(Ln-L) > 0.001 & z < 1

      % In L we store the best performance estimate found so far.
      % Ln is the actual performance (for the actual h)
      % If Ln > L we improve the bound L, and so we rest it.

      if Ln > L, L = Ln; end
      iter = iter+1;
      prwaitbar(100,100-100*exp(-iter/10));

      r = -0.5/(h^2);
      F = q(ones(1,m),:)'.*exp(D*r);           % density contributions
      FS = sum(F)*((m-1)/m); IFS = find(FS>0); % joint density distribution
      if islabtype(a,'crisp');
        G = sum(F .* (nlab(:,ones(1,m)) == nlab(:,ones(1,m))'));
        G = G.*(of-1)./of;                     % true-class densities
      else
        % here we are for soft labels (stored in targets)
        G = zeros(1,m);
        for j=1:c
          G = G + sum(F .* (a.targets(:,j) * a.targets(:,j)'));
          % to be corrected for bias?
        end
      end

      % performance estimate
      en = max(p)*ones(1,m);
      en(IFS) = (G(IFS))./FS(IFS);
      Ln = exp(sum(log(en))/m);

      if Ln < L            % compute next estimate
        z = sqrt(z);       % adjust stepsize up (recall: 0 < z < 1)
        h = h / z;         % if we don't improve, increase h (approach h_opt from below)
      else
        h = h * z;         % if we improve, decrease h (approach h_opt from above)
      end
    end
    prwaitbar(0);
    W = prmapping('parzen_map','trained',{a,repmat(h,c,k);},getlablist(a),k,c);
    W = setname(W,mapname);
    W = setcost(W,a);

  end

return


function [dP] = GradJacobiP(r, alpha, beta, N);

% function [dP] = GradJacobiP(r, alpha, beta, N);
% Purpose: Evaluate the derivative of the Jacobi polynomial of type (alpha,beta)>-1,
%	       at points r for order N and returns dP[1:length(r))]

dP = zeros(length(r), 1);
if(N == 0)
  dP(:,:) = 0.0;
else
  dP = sqrt(N*(N+alpha+beta+1))*JacobiP(r(:),alpha+1,beta+1, N-1);
end;
return


% Hoer's code (P. O. Hoyer. Non-negative Matrix Factorization with sparseness constraints.
% Journal of Machine Learning Research  5:1457-1469, 2004.) is modified

function [W, H, objhistory, objhistory_v] = nmf( V, rdim, showflag, ttt )
%% INPUT
% V: data matrix
% rdim : matrix factorization rank
% showflag: if it is 1. than it plots the change of reconstruction error
% for each iteration
% ttt: maximum number of iterations allowed

%% OUTPUT
% W: Mixing matrix (V=WH)
% H: Encoding matrix (V=WH)
% objhistory: change of total reconstruction error
% objhistory_v: reconstruction error for each individual sample

% Check that we have non-negative data
if min(V(:))<0, error('Negative values in data!'); end

% Dimensions
vdim = size(V,1);
samples = size(V,2);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% initialization %%%
fname2=['initials/Initials' num2str(vdim) 'x' num2str(rdim) '.txt'];
fid=fopen(fname2,'r');
if (fid==-1)
    ssbinitial(vdim,rdim);
end
fidW2 = fopen(fname2,'r');
W = fscanf(fidW2,'%f', [vdim inf]);
fclose(fidW2);

clear fname2

fname2=['initials/Initials' num2str(rdim) 'x' num2str(samples) '.txt'];
fid=fopen(fname2,'r');
if (fid==-1)
    ssbinitial(rdim,samples);
end
fidW2 = fopen(fname2,'r');
H = fscanf(fidW2,'%f', [rdim inf]);
fclose(fidW2);

clear fname2

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

if (showflag==1)
    objhistory = ((sum(sum((V-W*H).^2))))/(vdim*samples);
    figure(2); clf;
    drawnow;
end

% Start iteration
iter = 0;
while 1,

    if (iter==ttt)
        break
    end
    iter = iter+1;
    % Compute new W and H (Lee and Seung; NIPS*2000)
    H = H.*(W'*V)./(W'*W*H + 1e-9);
    W = W.*(V*H')./(W*H*H' + 1e-9);

%     norms = sqrt(sum(W.^2));
%     H = H.*(norms'*ones(1,samples));
%     W = W./(ones(vdim,1)*norms);

    newobj = ((sum(sum((V-W*H).^2))))/(vdim*samples);
    newobj_v = ((sum(sum((V(:,end)-W*H(:,end)).^2))))/(vdim);
    if iter==1
        objhistory = [newobj];
        objhistory_v = [newobj_v];
    else
        objhistory = [objhistory newobj];
        objhistory_v = [objhistory_v newobj_v];
    end

    if(showflag==1)
        if (iter>1)
            plot(objhistory(2:end));
        end
        drawnow;
    end
end


function [ n_data, n, x, fx ] = laguerre_polynomial_values ( n_data )

%*****************************************************************************80
%
%% LAGUERRE_POLYNOMIAL_VALUES returns some values of the Laguerre polynomial.
%
%  Discussion:
%
%    In Mathematica, the function can be evaluated by:
%
%      LaguerreL[n,x]
%
%  Differential equation:
%
%    X * Y'' + (1-X) * Y' + N * Y = 0
%
%  First terms:
%
%      1
%     -X   +  1
%   (  X^2 -  4 X   +   2 ) / 2
%   ( -X^3 +  9 X^2 -  18 X   +    6 ) / 6
%   (  X^4 - 16 X^3 +  72 X^2 -   96 X +      24 ) / 24
%   ( -X^5 + 25 X^4 - 200 X^3 +  600 X^2 -   600 X   +   120 ) / 120
%   (  X^6 - 36 X^5 + 450 X^4 - 2400 X^3 +  5400 X^2 -  4320 X   +   720 ) / 720
%   ( -X^7 + 49 X^6 - 882 X^5 + 7350 X^4 - 29400 X^3 + 52920 X^2 - 35280 X + 5040 ) / 5040
%
%  Recursion:
%
%    L(0)(X) = 1,
%    L(1)(X) = 1-X,
%    N * L(N)(X) = (2*N-1-X) * L(N-1)(X) - (N-1) * L(N-2)(X)
%
%  Orthogonality:
%
%    Integral ( 0 <= X < oo ) exp ( - X ) * L(N)(X) * L(M)(X) dX
%    = 0 if N /= M
%    = 1 if N == M
%
%  Special values:
%
%    L(N)(0) = 1.
%
%  Relations:
%
%    L(N)(X) = (-1)^N / N! * exp ( x ) * (d/dx)^n ( exp ( - x ) * X^n )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Milton Abramowitz and Irene Stegun,
%    Handbook of Mathematical Functions,
%    US Department of Commerce, 1964.
%
%    Stephen Wolfram,
%    The Mathematica Book,
%    Fourth Edition,
%    Wolfram Media / Cambridge University Press, 1999.
%
%  Parameters:
%
%    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
%    first call.  On each call, the routine increments N_DATA by 1, and
%    returns the corresponding data; when there is no more data, the
%    output value of N_DATA will be 0 again.
%
%    Output, integer N, the order of the polynomial.
%
%    Output, real X, the point where the polynomial is evaluated.
%
%    Output, real FX, the value of the function.
%
  n_max = 17;

  fx_vec = [ ...
      0.1000000000000000E+01, ...
      0.0000000000000000E+00, ...
     -0.5000000000000000E+00, ...
     -0.6666666666666667E+00, ...
     -0.6250000000000000E+00, ...
     -0.4666666666666667E+00, ...
     -0.2569444444444444E+00, ...
     -0.4047619047619048E-01, ...
      0.1539930555555556E+00, ...
      0.3097442680776014E+00, ...
      0.4189459325396825E+00, ...
      0.4801341790925124E+00, ...
      0.4962122235082305E+00, ...
     -0.4455729166666667E+00, ...
      0.8500000000000000E+00, ...
     -0.3166666666666667E+01, ...
      0.3433333333333333E+02  ];

  n_vec = [ ...
     0,  1,  2, ...
     3,  4,  5, ...
     6,  7,  8, ...
     9, 10, 11, ...
    12,  5,  5, ...
     5,  5 ];

  x_vec = [ ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     1.0E+00, ...
     0.5E+00, ...
     3.0E+00, ...
     5.0E+00, ...
     1.0E+01 ];

  if ( n_data < 0 )
    n_data = 0;
  end

  n_data = n_data + 1;

  if ( n_max < n_data )
    n_data = 0;
    n = 0;
    x = 0.0;
    fx = 0.0;
  else
    n = n_vec(n_data);
    x = x_vec(n_data);
    fx = fx_vec(n_data);
  end

  return
end


function X = slpcarecon(S, Y)
%SLPCARECON Reconstructs the samples in original space
%
% $ Syntax $
%   - Xr = slpcarecon(S, Y)
%
% $ Arguments $
%   - S:        the PCA model struct
%   - Y:        the principal component features
%   - Xr:       the reconstructed samples
%
% $ Description $
%   - Xr = slpcarecon(S, Y) reconstructs the original samples approximately
%     using the principal components Y. If the dimension of Y is less than
%     the subspace dimension, the leading space dimensions will be used.
%
% $ History $
%   - Created by Dahua Lin, on Aug 17, 2006
%   - Modified by Dahua Lin, on Sep 10, 2006
%       - replace sladd by sladdvec to increase efficiency
%

%% parse and verify input

if ~isstruct(S)
    error('sltoolbox:invalidarg', ...
        'S should be a PCA model struct');
end

if ~isnumeric(Y) || ndims(Y) ~= 2
    error('sltoolbox:invalidarg', ...
        'The features Y should be a 2D numeric matrix');
end

dy = size(Y, 1);
if dy > S.feadim
    error('sltoolbox:sizmismatch', ...
        'The feature dimension of Y exceeds the subspace dimension preserved in model');
end

%% reconstruct

if dy == S.feadim
    X = S.P * Y;
else
    X = S.P(:, 1:dy) * Y;
end

X = sladdvec(X, S.vmean, 1);


function stroud_test2075 ( )

%*****************************************************************************80
%
%% STROUD_TEST2075 tests the rules for EPN with GLG weight on monomials.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 January 2010
%
%  Author:
%
%    John Burkardt
%
  test_num = 5;

  alpha_test = [ - 0.5, 0.0, 0.5, 1.0, 2.0 ];

  fprintf ( 1, '\n' );
  fprintf ( 1, 'STROUD_TEST2075\n' );
  fprintf ( 1, '  Demonstrate the use of quadrature rules for the region\n' );
  fprintf ( 1, '  EPN_GLG, that is, the positive half space [0,+oo)^N, with the\n' );
  fprintf ( 1, '  weight W(ALPHA;X) = product ( 1 <= I <= N ) X(I)^ALPHA exp ( -X(I) )\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  We use the formulas to integrate various monomials of\n' );
  fprintf ( 1, '  the form X(1)^E(1) * X(2)^E(2) * ... X(N)^E(N)\n' );
  fprintf ( 1, '  and compare to the exact integral.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The precision of each formula is known, and we only use\n' );
  fprintf ( 1, '  a formula if its precision indicates it should be able to\n' );
  fprintf ( 1, '  produce an exact result.\n' );

  for n = 1 : 6

    expon = zeros ( n, 1 );
    for test = 1 : test_num
      alpha = alpha_test(test);
      epn_glg_test ( n, expon, alpha );
    end

    expon = zeros ( n, 1 );
    expon(n) = 1;
    for test = 1 : test_num
      alpha = alpha_test(test);
      epn_glg_test ( n, expon, alpha );
    end

    if ( 2 <= n )
      expon = zeros ( n, 1 );
      expon(1) = 1;
      expon(2) = 1;
      for test = 1 : test_num
        alpha = alpha_test(test);
        epn_glg_test ( n, expon, alpha );
      end
    end

    expon = zeros ( n, 1 );
    expon(1) = 2;
    for test = 1 : test_num
      alpha = alpha_test(test);
      epn_glg_test ( n, expon, alpha );
    end

  end

  return
end


function b = ismonom(a)
% function B = ismonom(A)
%
% DESCRIPTION
%   Returns true for a monomial or a vector or matrix of monomials.
%
% INPUTS
%   A: polynomial
%
% OUTPUTS
%   B: 1 if A is a monomial or a vector or matrix of monomials.  Returns
%      0 otherwise.
%
% SYNTAX
%   B = ismonom(A);

% 1/29/2008: PJS  Initial Coding

if isa(a,'double') && a==1
    b = true;
    return;
elseif ~isa(a,'polynomial')
    b = false;
    return;
end

% acoef will be Nterms-by-(Nrows*Ncols)
acoef = a.coefficient;

if all(nonzeros(acoef)==1) && all(sum(acoef,1)==1)
    b = true;
else
    b = false;
end


function example4 ( )

%*****************************************************************************80
%
%% EXAMPLE4 uses BVP4C to solve the EXAMPLE4 problem.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 September 2013
%
%  Author:
%
%    Original MATLAB version by Shampine, Kierzenka, Reichelt.
%    This version by John Burkardt.
%
%  Reference:
%
%    Lawrence Shampine, Jacek Kierzenka, Mark Reichelt,
%    Solving boundary value problems for ordinary differential equations
%    in MATLAB with bvp4c.
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'EXAMPLE4:\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Use BVP4C to solve a boundary value problem with\n' );
  fprintf ( 1, '  a periodic solution of unknown period P.\n' );
  fprintf ( 1, '  We solve this on [0,1], with P an additional unknown.\n' );
  fprintf ( 1, '  y'' = 3 ( y + z - y^3/3 - 1.3\n' );
  fprintf ( 1, '  z'' = - ( y - 0.7 + 0.8 * z ) / 3\n' );
  fprintf ( 1, '  y(0) = y(P), z(0) = z(P)\n' );
  fprintf ( 1, '  Use initial guess y = sin ( 2 pi x ), z = cos ( 2 pi x ).\n' );
%
%  Set SOLINIT, the structure defining the initial guess.
%
  x_init = linspace ( 0.0, 1.0, 5 );
  p_init = 2.0 * pi;
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Initial estimate for P is %g\n', p_init );
  solinit = bvpinit ( x_init, @example4_init, p_init );
%
%  Have BVP4C solve the problem.
%
  sol = bvp4c ( @example4_ode, @example4_bc, solinit );
%
%  Retrieve the updated value of the period.
%
  p = sol.parameters;
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Period P = %g\n', p );
%
%  Use DEVAL to evaluate the solution.
%
  x = linspace ( 0.0, 1.0, 101 );
  px = p * x;
  sol = deval ( sol, x );
%
%  Evaluate the initial guess on the initial grid [0,1].
%
  y_init = example4_init ( x );
%
%  Display a plot of Y versus initial guess.
%
  plot ( px, sol(1,:), 'r-', ...
         px, y_init(1,:), 'g-', 'Linewidth', 2 );
  xlabel ( '<--- X --->', 'Fontsize', 16 );
  ylabel ( '<--- Y --->', 'Fontsize', 16 );
  title ( 'EXAMPLE4: Y(red) versus initial guess (green)', 'Fontsize', 16 )
  grid on
  filename = 'example4.png';
  print ( '-dpng', filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Saving plot file as "%s"\n', filename );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'EXAMPLE4:\n' );
  fprintf ( 1, '  Normal end of execution.\n' );
  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function y = example4_init ( x )

%*****************************************************************************80
%
%% EXAMPLE4_INIT evaluates the initial guess for the solution.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 September 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the point at which the ODE is to be evaluated.
%
%    Output, real Y(M,1), the value of the initial guess.
%
  y(1,:) = sin ( 2.0 * pi * x );
  y(2,:) = cos ( 2.0 * pi * x );

  return
end
function dydx = example4_ode ( x, y, p )

%*****************************************************************************80
%
%% EXAMPLE4_ODE evaluates the right hand side of the ODE.
%
%  Discussion:
%
%    We assume that the differential equation has been rewritten as a
%    system of first order equations of the form
%
%      dydx = f(x,y)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    07 September 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real X, the point at which the ODE is to be evaluated.
%
%    Input, real Y(M), the value of the solution at X.
%
%    Input, real P, the estimate for the period.
%
%    Output, real DYDX(M), the value of the right hand side given X and Y.
%
  dydx(1,1) = p * 3.0 * ( y(1) + y(2) - ( y(1) )^3 / 3.0 - 1.3 );
  dydx(2,1) =  - p * ( y(1) - 0.7 + 0.8 * y(2) ) / 3.0;

  return
end
function bc = example4_bc ( ya, yb, p )

%*****************************************************************************80
%
%% EXAMPLE4_BC evaluates the boundary conditions.
%
%  Discussion:
%
%    The third boundary condition applies the phase condition, and eliminates
%    the spurious solution y'(x) = 0, and solutions with p = 0.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    05 September 2013
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real YA(M), YB(M), the solution value at the left and right endpoints.
%
%    Input, real P, the estimate for the period.
%
%    Output, real BC(M), the value of the boundary conditions.
%
  bc(1,1) = ya(1) - yb(1);
  bc(2,1) = ya(2) - yb(2);
  bc(3,1) = p * ( ya(1) - 0.7 + 0.8 * ya(2) ) / 3.0 - 1.0;

  return
end
function timestamp ( )

%*****************************************************************************80
%
%% TIMESTAMP prints the current YMDHMS date as a timestamp.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  t = now;
  c = datevec ( t );
  s = datestr ( c, 0 );
  fprintf ( 1, '%s\n', s );

  return
end


function [ x, seed ] = r8vec_uniform_01 ( n, seed )

%*****************************************************************************80
%
%% R8VEC_UNIFORM_01 returns a unit pseudorandom R8VEC.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Second Edition,
%    Springer, 1987,
%    ISBN: 0387964673,
%    LC: QA76.9.C65.B73.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, December 1986, pages 362-376.
%
%    Pierre L'Ecuyer,
%    Random Number Generation,
%    in Handbook of Simulation,
%    edited by Jerry Banks,
%    Wiley, 1998,
%    ISBN: 0471134031,
%    LC: T57.62.H37.
%
%    Peter Lewis, Allen Goodman, James Miller,
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, Number 2, 1969, pages 136-143.
%
%  Parameters:
%
%    Input, integer N, the number of entries in the vector.
%
%    Input, integer SEED, a seed for the random number generator.
%
%    Output, real X(N,1), the vector of pseudorandom values.
%
%    Output, integer SEED, an updated seed for the random number generator.
%
  x = zeros ( n, 1 );

  i4_huge = 2147483647;

  if ( seed == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R8VEC_UNIFORM_01 - Fatal error!\n' );
    fprintf ( 1, '  Input SEED = 0!\n' );
    error ( 'R8VEC_UNIFORM_01 - Fatal error!' );
  end

  r = zeros ( n, 1 );

  for i = 1 : n

    k = floor ( seed / 127773 );

    seed = 16807 * ( seed - k * 127773 ) - k * 2836;

    if ( seed < 0 )
      seed = seed + i4_huge;
    end

    x(i) = seed * 4.656612875E-10;

  end

  return
end


function [ x, seed ] = r4vec_uniform_ab ( n, a, b, seed )

%*****************************************************************************80
%
%% R4VEC_UNIFORM_AB returns a scaled pseudorandom R4VEC.
%
%  Discussion:
%
%    Each dimension ranges from A to B.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Springer Verlag, pages 201-202, 1983.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%    Peter Lewis, Allen Goodman, James Miller,
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, pages 136-143, 1969.
%
%  Parameters:
%
%    Input, integer N, the number of entries in the vector.
%
%    Input, real A, B, the range of the pseudorandom values.
%
%    Input, integer SEED, a seed for the random number generator.
%
%    Output, real X(N), the vector of pseudorandom values.
%
%    Output, integer SEED, an updated seed for the random number generator.
%
  x = zeros ( n, 1 );

  if ( seed == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'R4VEC_UNIFORM_AB - Fatal error!\n' );
    fprintf ( 1, '  Input SEED = 0!\n' );
    error ( 'R4VEC_UNIFORM_AB - Fatal error!' );
  end

  for i = 1 : n

    k = floor ( seed / 127773 );

    seed = 16807 * ( seed - k * 127773 ) - k * 2836;

    if ( seed < 0 )
      seed = seed + 2147483647;
    end

    x(i) = a + ( b - a ) * seed * 4.656612875E-10;

  end

  return
end


function niederreiter2_test01 ( )

%*****************************************************************************80
%
%% NIEDERREITER2_TEST01 tests SETFLD2.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 November 2008
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'NIEDERREITER2_TEST01\n' );
  fprintf ( 1, '  SETFLD2 returns the addition, multiplication, and\n' );
  fprintf ( 1, '  subtraction tables for base 2.\n' );

  [ add, mul, sub ] = setfld2 ( 0 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Addition table:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '+  0  1\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '0  %d  %d\n', add(1,1), add(1,2) );
  fprintf ( 1, '1  %d  %d\n', add(2,1), add(2,2) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Multiplication table:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '*  0  1\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '0  %d  %d\n', mul(1,1), mul(1,2) );
  fprintf ( 1, '1  %d  %d\n', mul(2,1), mul(2,2) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Subtraction table:\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '-  0  1\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '0  %d  %d\n', sub(1,1), sub(1,2) );
  fprintf ( 1, '1  %d  %d\n', sub(2,1), sub(2,2) );

  return
end


function [c, s, active_set] = oasisAR1(y, g, lam, smin, active_set)
%% 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} >=s_min or =0

%% inputs:
%   y:  T*1 vector, One dimensional array containing the fluorescence intensities
%withone entry per time-bin.
% OR %%
% len_active_set*4 matrix, active set

%   g:  scalar, Parameter of the AR(1) process that models the fluorescence ...
%impulse response.
%   lam:  scalar, sparsity penalty parameter lambda.
%   smin: scalar, optional, default 0
%miniumal non-zero activity within each bin (minimal 'spike size').
%   active_set: npool x 4 matrix, warm stared active sets

%% outputs
%   c: T*1 vector, the inferred denoised fluorescence signal at each time-bin.
%   s: T*1 vector, discetized deconvolved neural activity (spikes)
%   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

%% initialization
y = reshape(y, [], 1);
if isempty(y)
    T = sum(active_set(:,4));
else
T = length(y);
end
if ~exist('g', 'var') || isempty(g)
    g = estimate_time_constant(y);
elseif length(g)>1
    c = zeros(T,1);
    s = zeros(T,1);
    active_set = [];
    return;
end
if ~exist('lam', 'var') || isempty(lam);   lam = 0; end
if ~exist('smin', 'var') || isempty(smin);   smin = 0; end
if ~exist('active_set', 'var') || isempty(active_set)
    len_active_set = T;
    active_set = [y-lam*(1-g),ones(T,1),(1:T)',ones(T,1),(1:T)'-1, (1:T)'+1]; % each row is one pool: (vi, wi, t, l)
    active_set(end, :) = [y(end)-lam,1,T,1,T-1,nan] ;
    active_set(1,5) = nan;
else
    len_active_set = size(active_set,1);
    active_set(:,5) = [nan; (1:len_active_set-1)'];
    active_set(:,6) = [(2:len_active_set)';nan];
end
idx = true(len_active_set,1);

%% run OASIS
ii = 1;
ii_next = active_set(ii,6);
while ~isnan(ii_next)
    % find the active set
    while (~isnan(ii_next)) && (active_set(ii_next,1)/active_set(ii_next,2)...
            >=active_set(ii,1)/active_set(ii,2)*g^(active_set(ii,4))+smin)
        active_set(ii_next,5) = ii;
        ii = ii_next;
        ii_next = active_set(ii,6);
    end

    if isnan(ii_next); break; end

    %% merge pools
    active_set(ii,1) = active_set(ii,1) + active_set(ii_next,1)* (g^(active_set(ii,4)));
    active_set(ii,2) = active_set(ii,2) + active_set(ii_next,2)*(g^(2*active_set(ii,4)));
    active_set(ii,4) = active_set(ii,4) + active_set(ii_next,4);
    active_set(ii,6) = active_set(ii_next,6);
    idx(ii_next) = false;
    ii_next = active_set(ii,6);
    ii_prev = active_set(ii, 5);

    %% backtrack until violations fixed
    while (~isnan(ii_prev)) && (active_set(ii,1)/active_set(ii,2)<...
            max(0, active_set(ii_prev,1)/active_set(ii_prev,2)*g^(active_set(ii_prev,4)))+smin)
        ii_next = ii;
        ii = ii_prev;
        active_set(ii,1) = active_set(ii,1) + active_set(ii_next,1)* (g^(active_set(ii,4)));
        active_set(ii,2) = active_set(ii,2) + active_set(ii_next,2)*(g^(2*active_set(ii,4)));
        active_set(ii,4) = active_set(ii,4) + active_set(ii_next,4);
        active_set(ii,6) = active_set(ii_next,6);
        idx(ii_next) = false;

        ii_prev = active_set(ii, 5);
        ii_next = active_set(ii,6);
    end
end
active_set(~idx, :) = [];
len_active_set = size(active_set,1);

%% construct solution for all t
c = zeros(T, 1);
s = c;
for ii=1:len_active_set
    t0 = active_set(ii,3);
    tau = active_set(ii, 4);
    c(t0:(t0+tau-1)) = max(0,active_set(ii,1)/active_set(ii,2)) * (g.^(0:(tau-1)));
end

s(active_set(2:end,3)) = c(active_set(2:end,3)) - g*c(active_set(2:end,3)-1);


function out = ij2xy(in, maxy)
% out = xy2ij(in, maxy)
%
% Converts shapes from "image" coordinates to cartesian coordinates.
% In cartesian coordinates, the origin is on the lower-left corner of
% the image and y moves vertically while x moves horizontally.
% Image coordinates follow a matrix notation where the origin is in
% the upper left corner and the first coordinate 'i' moves vertically
% (in the opposite direction of y), while the second 'j' coordinate
% moves horizontally in the same direction as x.
%
%                         PARAMETERS
%
% in A Nx2xS matrix containing S shapes and N landmarks,
%    in images coordinates: [i j]
% maxy Number of rows of the image matrix, or height of the displayed image,
%      in pixels.
%
%                          RETURNS
%
% out A Nx2xS matrix containing S shapes and N landmarks,
%     in cartesian coordinates: [x y]
%
% Author: Luca Vezzaro (elvezzaro@gmail.com)

	out(:,1,:) = in(:,2,:);
	out(:,2,:) = repmat(maxy, [size(in, 1) 1 size(in,3)]) - in(:,1,:);


function [U,Out] = RecPF(m,n,aTV,aL1,picks,B,PsiT,Psi,opts,varargin)
% [U,Out] = RecPF(m,n,aTV,aL1,picks,B,PsiT,Psi,opts,varargin)
%
% RecPF solves the TVL1-L2 model:
%
%   min aTV*TV(u) + aL1*|PsiT*U|_1 + 0.5|Fp*U - B|_2^2
%
% Inputs:
%
%  m, n     -- size of image
%  aTV, aL1 -- regularization parameters in the model
%  picks    -- sample positions in Fourier domain
%  B        -- measurment vector
%  PsiT     -- sparsifying basis, PsiT*U is the sparse representation of U
%  Psi      -- inverse of PsiT, Psi*x = U reconstructs the image
%  opts      --- contains parameters for algorithm
%              * opts.mit_inn: maxium inner iteration number for each beta {default 30}
%              * opts.mit_out: maxium outer iteration number {default 10}
%              * opts.tol_inn: inner iteration error tolerance {1.e-3}
%                (this option is effective only when "opts.stc = 2", see below)
%              * opts.tol_rel_inn: tolerance of relative change in an inner iteration {5.e-2}
%              * opts.tol_rel_out: tolerance of relative change in an outer iteration {1.e-2}
%                (the above two options are effective only when "opts.stc = 1", see below)
%              * opts.beta0:   initial penalty parameter {2^5}
%              * opts.beta_max: final penalty parameter  {2^15}
%              * opts.beta_rate: increase rate of beta
%              * opts.idisp: 0 or nonzero, display inner iteration info or not
%              * opts.recordf: 0 or 1, keep (or not) history of function values, TV and fidelity;
%              * opts.U0: starting poing {default "a least squares solution"}
%              * opts.wbarflag: 1 (on) or 0 (off), controls wait bar.
%              * opts.stc: 1 (stopping criterion based on Relative Change)
%                          or 2 (stopping criterion based on optimality conditions) {default 1}
%              * opts.TVtype: 1 or 2, corresponding to anisotropic/isotropic TV {default 2}
%  varargin{1}  -- a m x n matrix contains local weights of TV. Specifically, the local weigthed
%                  TV is discretized as:
%                     TV(u) = sum_i w_i ||D_i u||.
%                  If all w_i == 1, then it is just the isotropic discritization of normal TV.
%                  We require all w_i > 0.
%  varargin{2}  -- true image (used to compute relative errors when it is present)
%
% Outputs:
%     U   --- reconsctructed image
%     Out --- a structrue contains
%             * Out.iter: total iteration number
%             * Out.Inner: inner iteration numbers for each beta
%             * Out.ftrue: function values at each iteration
%             * Out.Fvalvscpu: function values decrease with respect to CPU time
%             * Out.TVhist: total variation changes with iteration
%             * Out.FIDhist: fidelity history
%              {the above four subfields are present only when opts.recordf = 1}
%             * Out.ITvsERR: relative error vs. iteration number
%             * Out.CPUvsERR: CPU time vs. relative error
%              {the above two subfields are present only when the original image is present}

%
% Yin Zhang, 11-10-2007
% CAAM, Rice University, Copyright (2007)
%
% Junfeng Yang, last modified on Feb. 2, 2009
%

global Ux Uy FU PsiTU
global Wx Wy
global Z PsiZ
global beta
global remain

if aTV == 0 && aL1 == 0; error('No regularization' ); end
if aTV <  0 || aL1 <  0; error('Regularization < 0'); end
if ~exist('opts','var'); opts = []; end

[mit_inn,mit_out,tol_inn,tol_rel_inn,tol_rel_out,beta0,beta_max, ...
    beta_rate,TVtype,idisp,recordf,U0,wbarflag,stc] = setopts(opts);

[Nomin1,Denom1,Denom2] = getC(picks,B,aTV,m,n);

remain = setdiff(1:m*n,picks);
if isempty(U0); U = zeros(m,n); else U = U0; clear U0; end

if ~isempty(varargin)
    Weights = varargin{1};
    [mm,nn] = size(Weights);
    if mm~=m || nn~= n
        Weights = ones(m,n);
    elseif find(Weights < 0,1)
        error('negative weights are not allowed!');
    end
else
    Weights = ones(m,n);
end
if length(varargin) == 2
    I = varargin{2};
    nrmI = norm(I(:));  rer = norm(U(:)-I(:))/nrmI;
    RER = zeros(500,2); RER(1,:) = [0,rer];
    CPUvsRER = zeros(500,2); CPUvsRER(1,:) = [0,rer];
end

if aL1 > 0; PsiTU = PsiT(U); end

if aTV > 0
    Ux = [diff(U,1,2), U(:,1) - U(:,n)];
    Uy = [diff(U,1,1); U(1,:) - U(m,:)];
end

if recordf
    fval_true = funcval(U,aTV,aL1,B,picks);
    FVAL = zeros(500,2);
    FVAL(1,:) = [0,fval_true];
    Fvalvscpu = zeros(500,2);
    Fvalvscpu(1,:) = [0,fval_true];
    TVhist = zeros(500,1);
    FIDhist = zeros(500,1);
end

% initialization
Inn = zeros(100,1);
beta = beta0;
totalIter = 0;
Outiter = 0;
stopc = 0;
t0 = cputime;

if wbarflag == 1
    wbar = waitbar(0, 'RecPF is running, please wait ...');
end

%% Main loop
while ~stopc
    Outiter = Outiter + 1;
    if stc == 1; Uo = U; end

    Denom = Denom1;
    if aTV > 0; Denom = Denom + (aTV*beta)*Denom2; end
    if aL1 > 0; Denom = Denom + aL1*beta; end

    stopci = 0; Inniter = 0;
    while ~stopci

        % ================================
        %  Begin Alternating Minimization
        % ----------------
        %   W-subprolem
        % ----------------
        if aTV > 0;
            switch TVtype
                case 1;   % anisotropic TV
                    Wx = sign(Ux).* max(abs(Ux)-Weights./beta,0);
                    Wy = sign(Uy).* max(abs(Uy)-Weights./beta,0);
                case 2;   % isotropic TV
                    V = sqrt(Ux.^2 + Uy.^2);
                    S = max(V - Weights./beta, 0);
                    S = S ./ max(V,eps);
                    Wx = S.*Ux; Wy = S.*Uy;
                    clear V S
                otherwise; error('TVtype must be 1 or 2');
            end
        end

        % ----------------
        %   Z-subprolem
        % ----------------
        if aL1 > 0;
            Z = sign(PsiTU).*max(abs(PsiTU)-1/beta,0);
            PsiZ = Psi(Z);
        end

        % ----------------
        %   U-subprolem
        % ----------------
        if stc == 1; Ui = U; end
        rhs = 0;
        if aTV > 0
            rhs = [Wx(:,end) - Wx(:, 1), -diff(Wx,1,2)];
            rhs = rhs + [Wy(end,:) - Wy(1, :); -diff(Wy,1,1)];
            rhs = (aTV*beta)*rhs;
        end
        if aL1 > 0
            rhs = rhs + (aL1*beta)*PsiZ;
        end

        Nomin = Nomin1 + fft2(rhs);

        FU = Nomin./Denom;
        U = real(ifft2(FU));
        Inniter = Inniter + 1;
        totalIter = totalIter + 1;
        %
        %  End Alternating Minimization
        % ================================

        % -----------------------------------------
        % check if inner stopping criterion is met
        %
        if stc == 1
            if aTV > 0
                Ux = [diff(U,1,2), U(:,1) - U(:,n)];
                Uy = [diff(U,1,1); U(1,:) - U(m,:)];
            end
            if aL1 > 0; PsiTU = PsiT(U); end
            chg_inn = norm(Ui(:) - U(:))/norm(U(:));
            stopci = ((chg_inn < tol_rel_inn) || (Inniter >= mit_inn));
        elseif stc == 2
            [res_wn,res_wz,wzr,res_Zn,res_Zz,Zzr,res_u] = checkopt(U,aTV,aL1,PsiT,picks,B,0,Weights);
            res = [res_wn,res_wz,res_Zn,res_Zz,res_u];
            stopci = (max(res) < tol_inn || (Inniter >= mit_inn));
        else
            error('please specify a stopping criterion.');
        end

        if recordf && totalIter < 500
            [fval_true,tvu,fidu] = funcval(U,aTV,aL1,B,picks);
            TVhist(totalIter) = tvu;
            FIDhist(totalIter) = fidu;
            FVAL(totalIter+1,:) = [totalIter,fval_true];
            Fvalvscpu(totalIter+1,:) = [cputime - t0, fval_true];
        end
        if exist('I','var') && totalIter < 500
            rer = norm(U(:)-I(:))/nrmI;
            RER(totalIter+1,:) = [totalIter,rer];
            CPUvsRER(totalIter+1,:) = [cputime - t0, rer];
        end
        if idisp && stc == 2
            fprintf('Iter: %d, res_ wn: %4.1e, wz: %4.1e, Zn: %4.1e, Zz: %4.1e, u: %4.1e, wzr %2.0f%%, Zzr %2.0f%%\n', ...
                totalIter, res_wn,res_wz,res_Zn,res_Zz,res_u,100*wzr,100*Zzr);
        elseif idisp && stc == 1
            fprintf('Iter: %d, chg_inn %4.2f\n',totalIter,chg_inn);
        end

    end % inner
    Inn(Outiter) = Inniter;

    % ------------------------------------------
    % check if outer stopping criterion is met
    %
    beta = beta_rate*beta;
    if stc == 1
        chg_out = norm(U(:)-Uo(:))/norm(U(:));
        stopc = ((chg_out < tol_rel_out) || (Outiter >= mit_out));
    elseif stc == 2
        stopc = ((beta > beta_max) || (Outiter >= mit_out));
    else
        error('please specify a stopping criterion.');
    end
    if wbarflag == 1
        waitbar(log2(beta)/(log2(beta_max)+1), wbar)
    end

end % outer
Out.iter = totalIter;
Out.Inner = Inn(1:Outiter);
if wbarflag == 1
    close(wbar);
end
if recordf
    Out.ftrue = FVAL(1:totalIter+1,:);
    Out.Fvalvscpu = Fvalvscpu(1:totalIter+1,:);
    Out.TVhist = TVhist(1:totalIter);
    Out.FIDhist = FIDhist(1:totalIter);
end
if exist('I','var')
    Out.ITvsRER  = RER(1:totalIter+1,:);
    Out.CPUvsRER = CPUvsRER(1:totalIter+1,:);
end

%% ----------------- SUBFUNCTION ---------------------------
function [res_wn,res_wz,wzr,res_Zn,res_Zz,Zzr,res_u] = ...
    checkopt(U,aTV,aL1,PsiT,picks,f,flag,Weights)
%
% This function checks the optimality of
%                   (              beta                 )
% min   aTV * sum_i (||(W_i)||_2 + ---- ||D_iu - W_i||^2)
%                   (               2                   )
%
%                   (         beta             )
%     + aL1 *       ( |Z|_1 + ---- |Z-PsiT*u|^2 )
%                   (           2              )
%
%     + .5 |F_p*u - f|^2
%
% where W_i = (Wx_i;Wy_i);
%
% U     --- current point
% f     --- measurment vector
% flag  --- 0 (do not check res_u), otherwise check res_u;
%           Generally, res_u << 0, so setting flag = 0 is fine.
% Weights -- local weights of TV
%

% Junfeng Yang, Aug. 08, 2008

global Ux Uy FU PsiTU
global Wx Wy
global beta
global remain
global Z PsiZ

[m,n] = size(U);
mn = m*n;

% res_wn, res_wz, wzr
if aTV > 0
    Ux = [diff(U,1,2), U(:,1) - U(:,n)];
    Uy = [diff(U,1,1); U(1,:) - U(m,:)];

    Dx = Wx - Ux;
    Dy = Wy - Uy;

    V = sqrt(Wx.^2 + Wy.^2);
    Iz = find(V == 0);

    if isempty(Iz)
        In = 1:mn;
    else
        In = find(V ~= 0);
        V(Iz) = 1;
    end

    V = V*beta;

    RWx = Dx + Weights.*Wx./V;
    RWy = Dy + Weights.*Wy./V;
    S = sqrt(RWx.^2 + RWy.^2);

    wzr = length(Iz)/mn;
    if isempty(In)
        res_wn = 0;
    else
        res_wn = max(S(In));
    end

    if isempty(Iz);
        res_wz = -1;
    else
        res_wz = max(S(Iz) - Weights(Iz)/beta);
    end

else
    res_wn = 0;
    res_wz = 0;
    wzr = 0;
end

% res_Zn, res_Zz, Zzr
if aL1 > 0
    PsiTU = PsiT(U);
    absPsiTU = abs(PsiTU);

    ZIn = find(Z ~= 0);
    if isempty(ZIn)
        res_Zn = 0;
    else
        R3 = (1/beta)*sign(Z(ZIn)) + Z(ZIn) - PsiTU(ZIn);
        res_Zn = max(abs(R3));
    end

    ZIz = find(Z == 0);
    if isempty(ZIz)
        res_Zz = -1;
    else
        R4 = absPsiTU(ZIz) - 1/beta;
        res_Zz = max(R4);
    end

    Zzr = length(ZIz)/m/n;

else
    PsiTU = 0;
    res_Zn = 0;
    res_Zz = -1;
    Zzr = 0;
end

% res_u
res_u = 0;
if flag == 0
    return;
else
    % res_u
    FU(picks) = -f + FU(picks);
    FU(remain) = 0;
    Ru = ifft2(FU);
    Ru = real(Ru);

    if aTV > 0
        Dxx = [Dx(:,1) - Dx(:,n), diff(Dx,1,2)];
        Dyy = [Dy(1,:) - Dy(m,:); diff(Dy,1,1)];
        Ru = Ru + (beta*aTV)*(Dxx + Dyy);
    end

    if aL1 > 0
        Ru = Ru + (aL1*beta)*(U - PsiZ);
    end
    res_u = max(abs(Ru(:)));
end
%% ------------- SUBFUNCTION ---------------
function [Nomin1,Denom1,Denom2] = getC(picks,B,aTV,m,n)

% compute fixed quantities
Nomin1 = zeros(m,n);
Nomin1(picks) = B;
Denom1 = zeros(m,n);
Denom1(picks) = 1;
Denom2 = 0;
if aTV > 0
    Denom2 = abs(psf2otf([1,-1],[m,n])).^2 + abs(psf2otf([1;-1],[m,n])).^2;
end
%% ----------  SUBFUNCTION ---------------
function [mit_inn,mit_out,tol_inn,tol_rel_inn,tol_rel_out,beta0,beta_max, ...
    beta_rate,TVtype,idisp,recordf,U0,wbarflag,stc] = setopts(opts)

% define default option fields
mit_inn = 30;
mit_out = 10;
tol_inn  = 1.e-3;
tol_rel_inn = 5.e-3;
tol_rel_out = 1.e-2;
beta0 = 2^5;
beta_max = 2^15;
beta_rate = 2;
TVtype = 2;
idisp = 0;
recordf = 0;
U0 = [];
wbarflag = 0;
stc = 1;

% change to specified option fields if exist
if ~isempty(opts);
    if ~isa(opts,'struct'); error('L1pfi: opts not a struct'); end
    if isfield(opts,'mit_inn'); mit_inn = opts.mit_inn; end
    if isfield(opts,'mit_out'); mit_out = opts.mit_out; end
    if isfield(opts,'tol_inn'); tol_inn = opts.tol_inn; end
    if isfield(opts,'tol_rel_inn'); tol_rel_inn = opts.tol_rel_inn; end
    if isfield(opts,'tol_rel_out'); tol_rel_out = opts.tol_rel_out; end
    if isfield(opts,'beta0');   beta0 = opts.beta0; end
    if isfield(opts,'beta_max'); beta_max = opts.beta_max; end
    if isfield(opts,'beta_rate'); beta_rate = opts.beta_rate; end
    if isfield(opts,'TVtype'); TVtype = opts.TVtype; end
    if isfield(opts,'idisp'); idisp = opts.idisp; end
    if isfield(opts,'recordf'); recordf = opts.recordf; end
    if isfield(opts,'U0'); U0 = opts.U0; end
    if isfield(opts,'wbarflag'); wbarflag = opts.wbarflag; end
    if isfield(opts,'stc'); stc = opts.stc; end
end


function d = cohens_d_2sample(input_values,binary_outcome)
% d = cohens_d_2sample(input_values,binary_outcome)
%
% This is for the two-sample case
% By Phil Kragel
%
% input_values: Continuous input values to test
% binary_outcome: Logical vector of 1/0 values for group A/B assignment

n1 = sum(~isnan(input_values(binary_outcome)) & ~isinf(input_values(binary_outcome)));
n0 = sum(~isnan(input_values(~binary_outcome)) & ~isinf(input_values(~binary_outcome)));

meanpres = mean(input_values(binary_outcome));
meanabs = mean(input_values(~binary_outcome));

v1 = var(input_values(binary_outcome));
v0 = var(input_values(~binary_outcome));

pooledsd = sqrt((v1.*(n1-1) + v0.*(n0-1)) ./ (n1 + n0 - 2));

d = (meanpres - meanabs) ./ pooledsd;

end


function [germs, germPaths] = centroidalVoronoi2d(germs, poly, varargin)
%CENTROIDALVORONOI2D Centroidal Voronoi tesselation within a polygon
%
%   PTS = centroidalVoronoi2d(NPTS, POLY)
%   Generate points in a polygon based on centroidal voronoi tesselation.
%   Centroidal germs can be computed by using the Llyod's algorithm:
%   1) initial germs are chosen at random within polygon
%   2) voronoi polygon of the germs is computed
%   3) the centroids of each domain are computed, and used as germs of the
%   next iteration
%
%   [PTS, PATHLIST] = centroidalVoronoi2d(NPTS, POLY)
%   Also returns the path of each germs at each iteration. The result
%   PATHLIST is a cell array with as many cells as the number of germs,
%   containing in each cell the successive positions of the germ.
%
%   PTS = centroidalVoronoi2d(.., PARAM, VALUE)
%   Specify one or several optional arguments. PARAM can be one of:
%   * 'nIter'   specifies the number of iterations of the algorithm
%       (default is 50)
%   * 'verbose' display iteration number. Default is false.
%
%   Example
%     poly = ellipseToPolygon([50 50 40 30 20], 200);
%     nGerms = 100;
%     germs = centroidalVoronoi2d(nGerms, poly);
%     figure; hold on;
%     drawPolygon(poly, 'k');
%     drawPoint(germs, 'bo');
%     axis equal; axis([0 100 10 90]);
%     % extract regions of the CVD
%     box = polygonBounds(poly);
%     [n, e] = boundedVoronoi2d(box, germs);
%     [n2, e2] = clipGraphPolygon(n, e, poly);
%     drawGraphEdges(n2, e2, 'b');
%
%   See also
%   graphs, boundedVoronoi2d, centroidalVoronoi2d_MC
%
%   Rewritten from programs found in
%   http://people.scs.fsu.edu/~burkardt/m_src/cvt/cvt.html
%
%   Reference:
%    Qiang Du, Vance Faber, and Max Gunzburger,
%    Centroidal Voronoi Tessellations: Applications and Algorithms,
%    SIAM Review, Volume 41, 1999, pages 637-676.
%

% ------
% Author: David Legland
% e-mail: david.legland@inra.fr
% Created: 2012-02-23,    using Matlab 7.9.0.529 (R2009b)
% Copyright 2012 INRA - Cepia Software Platform.

%% Parse input arguments

% Number of germs
if isscalar(germs)
    nGerms = germs;
    germs = [];
else
    nGerms = size(germs, 1);
end

% Number of iterations
nIter = 50;

verbose = false;

keepPaths = nargout > 1;

while length(varargin) > 1
    paramName = varargin{1};
    switch lower(paramName)
        case 'verbose'
            verbose = varargin{2};
        case 'niter'
            nIter = varargin{2};

        otherwise
            error(['Unknown parameter name: ' paramName]);
    end

    varargin(1:2) = [];
end

%% Initialisations

% bounding box of polygon
bbox = polygonBounds(poly);

% init germs if needed
if isempty(germs)
    germs = generatePointsInPoly(nGerms);
end
germIters = cell(nIter, 1);

%% Iteration of the Lloyd algorithm

for i = 1:nIter
     if verbose
        disp(sprintf('Iteration: %d/%d', i, nIter)); %#ok<DSPS>
    end

    if keepPaths
        germIters{i} = germs;
    end

    % Compute Clipped Voronoi diagram of germs
    if verbose
        disp('  compute Voronoi Diagram');
    end
    [n, e, f] = boundedVoronoi2d(bbox, germs);
    [n2, e2, f2] = clipMesh2dPolygon(n, e, f, poly); %#ok<ASGLU>

    % update the position of each germ
    if verbose
        disp('  compute centroids');
    end
    for iGerm = 1:nGerms
        polygon = n2(f2{iGerm}, :);
        germs(iGerm,:) = polygonCentroid(polygon);
    end

end

%% Evenutally compute germs trajectories

if nargout > 1
    % init
    germPaths = cell(nGerms, 1);
    path = zeros(nIter+1, 2);

    % Iteration on germs
    for i = 1:nGerms

        % create path corresponding to germ
        for j = 1:nIter
            pts = germIters{j};
            path(j,:) = pts(i,:);
        end
        path(nIter+1, :) = germs(i,:);

        germPaths{i} = path;
    end
end

function pts = generatePointsInPoly(nPts)
    % extreme coordinates
    xmin = bbox(1);  xmax = bbox(2);
    ymin = bbox(3);  ymax = bbox(4);

    % compute size of box
    dx = xmax - xmin;
    dy = ymax - ymin;

    % allocate memory for result
    pts = zeros(nPts, 2);

    % iterate until all points have been sampled within the polygon
    ind = (1:nPts)';
    while ~isempty(ind)
        NI = length(ind);
        x = rand(NI, 1) * dx + xmin;
        y = rand(NI, 1) * dy + ymin;
        pts(ind, :) = [x y];

        ind = ind(~polygonContains(poly, pts(ind, :)));
    end
end

end


function [W,H] = nmf(X,K,alg,maxiter,speak)
%
% NMF wrapper function
% function [W,H] = nmf(X,K,alg[,maxiter,speak])
%
% INPUT:
%           'X'     Inputmatrix
%           'K'     Number of components
%           'alg'   Algorithm to use:
%                   'mm'     multiplicative updates using euclidean
%                            distance. Lee, D..D., and Seung, H.S., (2001)
%                   'cjlin'  alternative non-negative least squares using
%                            projected gradients, author: Chih-Jen Lin,
%                            National Taiwan University.
%                   'prob'   probabilistic NFM interpretating X as samples
%                            from a multinomial, author: Lars Kai Hansen,
%                            Technical University of Denmark
%                   'als'    Alternating Least Squares. Set negative
%                            elements to zero.
%                   'alsobs' Alternating Least Squares. Set negative elements
%                            to zero and adjusts the other elements acording
%                            to Optimal Brain Surgeon.
%           'maxiter'   Maximum number of iterations, default = 1000.
%           'speak'     Print information to screen unless speak = 0,
%                       default = 0
%
% OUTPUT:
% W       : N x K matrix
% H       : K x M matrix
%
% Kasper Winther Joergensen
% Informatics and Mathematical Modelling
% Technical University of Denmark
% kwj@imm.dtu.dk
% 2006/12/15

switch(nargin)
    case {0,1,2}
        error('Missing parameter. Type "help nmf" for usage.');
        return
    case 3
        maxiter = 1000;
        speak = 0;
    case 4
        speak = 0;
    case 5
        % empty
    otherwise
        error('Too many parameters. Type "help nmf" for usage.');
        return
end

% find dimensionallity of X
[D,N] = size(X);

% switch algorithm
switch lower(alg)
    case 'mm'
        if speak, disp('Using mm algorithm'),end
        [W,H]=nmf_mm(X,K,maxiter,speak);
    case 'prob'
        if speak, disp('Using prob algorithm'),end
        [W,H]=nmf_prob(X,K,maxiter,speak);
    case 'cjlin'
        if speak, disp('Using cjlin algorithm'),end
        [W,H]=nmf_cjlin(X,rand(D,K),rand(K,N),0.000001,10000,maxiter);
    case 'als'
        if speak, disp('Using als algorithm'),end
        [W,H]=nmf_als(X,K,maxiter,speak);
    case 'alsobs'
        if speak, disp('Using alsobs algorithm'),end
        [W,H]=nmf_alsobs(X,K,maxiter,speak);
    otherwise
        error('Unknown method. Type "help nmf" for usage.');
        return
end

[W,H,nrgy] = order_comp(W,H);


%% Misorientation Distribution Function
% Explains how to compute and analyze misorientation distribution
% functions.
%
%% TODO
% Please help to redo the section
%
%%
% When speaking about the misorientation distribution function (MDF) one
% has to differentiate to cases
%
% # the boundary (correlated) misorientation distribution function
% # the uncorelated misorientation distribution function
%
% While the first one considers only misorientations at grain boundaries
% the second one considers misorietation between arbitrary crystal
% orientations. To illustrate the difference lets consider the following
% EBSD data set

% Lets import some EBSD data and reconstruct the grains.

mtexdata forsterite
grains = calcGrains(ebsd)

%% The boundary misorientation distribution function
%
% In order to compute the boundary misorientation distribution function for
% the phase transition from Forsterite to Enstatite we first extract the
% misorientations along all Forsterite to Enstatite boundary segements

mori_boundary = grains.boundary('Fo','En').misorientation

%%
% and second compute the corresponding density function using the command
% <orientation.calcDensity.html calcDensity>

mdf_boundary = calcDensity(mori_boundary,'halfwidth',5*degree)

%%

adf_boundary = mdf_boundary.calcAxisDistribution

plot(adf_boundary)

%%

%%
% The misorientation distribution function can be processed as any other
% ODF. E.g. we can compute the prefered misorientation via

[v,mori] = max(mdf_boundary)

%%
% or plot the pole figure corresponding to the crystal axis (1,0,0)

plotPDF(mdf_boundary,Miller(1,0,0,ebsd('Fo').CS))

%% The uncorrelated misorientation distribution function
%
% Alternatively the uncorrelated misorientation distribution function can be
% computed by providing the option *uncorrelated*

mori = calcMisorientation(ebsd('En'),ebsd('Fo'))
mdf_uncor = calcDensity(mori)

%%
% Obviously it is different from the boundary misorientation distribution
% function.

plotPDF(mdf_uncor,Miller(1,0,0,ebsd('Fo').CS))

%% Computing the uncorrelated misorientation function from two ODFs
%
% Let given two odfs

odf_fo = calcDensity(ebsd('fo').orientations,'halfwidth',10*degree)
odf_en = calcDensity(ebsd('en').orientations,'halfwidth',10*degree)

%%
% Then the uncorrelated misorientation function between these two ODFs can
% be computed by

mdf = calcMDF(odf_en,odf_fo)

%%
% This misorientation distribution function should be similar to the
% uncorrelated misorientation function computed directly from the ebsd data

plotPDF(mdf,Miller(1,0,0,ebsd('Fo').CS))

%% Analyzing misorientation functions
%
%

%% SUB: Angle distribution
%
% Let us first compare the actual angle distribution of the boundary
% misorientations with the theoretical angle distribution of the
% uncorrelated MDF.

close all
plotAngleDistribution(grains.boundary('fo','en').misorientation)

hold on

plotAngleDistribution(mdf)

hold off

%%
% For computing the exact values see the commands
% <SO3Fun.calcAngleDistribution.html calcAngleDistribution(mdf)> and
% <orientation.calcAngleDistribution.html calcAngleDistribution(ori)>.

%% SUB: Axis distribution
%
% The same we can do with the axis distribution. First the actual angle distribution of the boundary
% misorientations

plotAxisDistribution(grains.boundary('fo','en').misorientation,'smooth')

%%
% Now the theoretical axis distribution of the
% uncorrelated MDF.

plotAxisDistribution(mdf)

%%
% For computing the exact values see the commands
% <SO3Fun.calcAxisDistribution.html calcAxisDistribution(mdf)> and
% <orientation.calcAxisDistribution.html calcAxisDistribution(grains)>.

aD = calcDensity(axis(grains.boundary('fo','en').misorientation))


function h = complex(f, g)
%COMPLEX   Construct complex CHEBFUN3 from real and imaginary parts.
%   H = COMPLEX(F, G) returns the complex CHEBFUN3 F + i G, where F and G
%   are real valued CHEBFUN3 objects with the same domain.
%
% See also CHEBFUN3/IMAG, CHEBFUN3/CONJ, CHEBFUN3/ABS and CHEBFUN3/REAL.

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

if ( ~isreal(f) || ~isreal(g) )
    error('CHEBFUN:CHEBFUN3:complex:notReal1', ...
        'Inputs must be real.');
end
h = f + 1i*g;

end


% This is material illustrating the methods from the book
% Financial Modelling  - Theory, Implementation and Practice with Matlab
% source
% Wiley Finance Series
% ISBN 978-0-470-74489-5
%
% Date: 02.05.2012
%
% Authors:  Joerg Kienitz
%           Daniel Wetterau
%
% Please send comments, suggestions, bugs, code etc. to
% kienitzwetterau_FinModelling@gmx.de
%
% (C) Joerg Kienitz, Daniel Wetterau
%
% Since this piece of code is distributed via the mathworks file-exchange
% it is covered by the BSD license
%
% This code is being provided solely for information and general
% illustrative purposes. The authors will not be responsible for the
% consequences of reliance upon using the code or for numbers produced
% from using the code.

function [value] = BinarySABR_3(f, k, t, a, b, r, n)
% the value of a digital option within a SABR model
    epsilon = 1e-004;
    kp = k + epsilon;
    km = k - epsilon;
    sigmap = svol_2(a,b,r,n,f,kp,t);
    sigmam = svol_2(a,b,r,n,f,km,t);
    d1p = 1./(sigmap .* sqrt(t)).*(log(f./kp)+0.5*sigmap.^2*t);
    d2p = 1./(sigmap .* sqrt(t)).*(log(f./kp)-0.5*sigmap.^2*t);
    d1m = 1./(sigmam .* sqrt(t)).*(log(f./km)+0.5*sigmam.^2*t);
    d2m = 1./(sigmam .* sqrt(t)).*(log(f./km)-0.5*sigmam.^2*t);
    pp = f * normcdf(d1p) - kp .* normcdf(d2p);
    pm = f * normcdf(d1m) - km.* normcdf(d2m);
    value = (pm-pp) / (2*epsilon);
end