% In a paper you'll often see a p-value and an N, based on either a T-test,
% a paired T-test or a one-way ANOVA.  To get an intuition how "good" a
% p-value is given the N, this script simulates some of those tests.

%% General parameter settings
nrSimulatedExperiments = 1000;
sampleSizes = [10 20 50];
testToSimulate = '2WAYRMMAIN';   % Pick one from 'TTEST','1WAY',2WAYRMMAIN 2WAYRMINT
nrSampleSizes= numel(sampleSizes);
scale =1;
bayesFactor = nan(nrSampleSizes,nrSimulatedExperiments);
bayesFactorBIC = nan(nrSampleSizes,nrSimulatedExperiments);
pValue = nan(nrSampleSizes,nrSimulatedExperiments);
stat =  nan(nrSampleSizes,nrSimulatedExperiments);
effectSize = 0.25;
tic;nn=0;

if ~exist('showTimeToCompletion.m','file')
    % Showtimetocompletion is a function outside the toolbox -do nothing
    showTimeToCompletion = @(x,y)(1); %NOP
end
switch upper(testToSimulate)
    case 'TTEST'
        %% Two-Sample T Test
        for i=1:nrSimulatedExperiments
            for j = 1:nrSampleSizes
                X = randn([sampleSizes(j) 1]);
                Y = randn([sampleSizes(j) 1])+effectSize;
                [bayesFactor(j,i),pValue(j,i),~,stats] = bf.ttest2(X,Y,'scale',scale);
                [bayesFactorBIC(j,i)] = bf.bfFromT(stats.tstat,stats.df); % Calculate BIC approximation
                stat(j,i) = stats.tstat;
                nn = showTimeToCompletion(((i-1)*nrSampleSizes+j)/(nrSimulatedExperiments*nrSampleSizes),nn);
            end
        end
    case '1WAY'
        %% 1-WAY ANOVA - main effect
        nrLevels = 4;
        cntr=0;
        for i=1:nrSimulatedExperiments
            for j = 1:nrSampleSizes
                X= repmat((0:nrLevels-1),[sampleSizes(j) 1]);
                X=X(:);
                y = randn([sampleSizes(j)*nrLevels 1])+X*effectSize;
                subject = repmat(1:sampleSizes(j),[nrLevels 1])';
                tbl = table(X,y,subject(:));
                [bayesFactor(j,i),lme] = bf.anova(tbl,'y~X','scale',scale);

                tmp =anova(lme);
                pValue(j,i) =tmp.pValue(2); % pValue of the Main factor
                stat(j,i) = tmp.FStat(2);
                df1 = nrLevels-1;
                df2 = nrLevels*(sampleSizes(j)-1);
                [bayesFactorBIC(j,i)] = bf.bfFromF(tmp.FStat(2),df1,df2,sampleSizes(j));
                nn = showTimeToCompletion(((i-1)*nrSampleSizes+j)/(nrSimulatedExperiments*nrSampleSizes),nn);                        end
        end
    case {'2WAYRMMAIN','2WAYRMINT'}
        %%
        levels = [2 3];
        nrFactors = numel(levels);
        for i=1:nrSimulatedExperiments
            for j = 1:nrSampleSizes
                fac1 = repmat((1:levels(1))',[1 levels(2)]);
                fac2 = repmat(1:levels(2),[levels(1) 1 ]);
                first = effectSize*randn([levels(1) 1]);
                second = effectSize*randn([1 levels(2)]);
                interaction = effectSize.*fac1.*fac2;
                singleSubject = repmat(first,[1 levels(2)]) + repmat(second,[levels(1) 1]) + interaction;
                response = reshape(repmat(singleSubject,[1 1 sampleSizes(j)])+ randn([levels sampleSizes(j)]),[prod(levels)*sampleSizes(j) 1]);
                fac1 = reshape(repmat(fac1,[1 1 sampleSizes(j)]),[prod(levels)*sampleSizes(j) 1]);
                fac2 = reshape(repmat(fac2,[1 1 sampleSizes(j)]),[prod(levels)*sampleSizes(j) 1]);
                subject = reshape(repmat((1:sampleSizes(j)),[prod(levels) 1 ]),[prod(levels)*sampleSizes(j) 1]);
                tbl = table(response,fac1,fac2,subject);
                switch upper(testToSimulate)
                    case '2WAYRMMAIN'
                        % Main effect Factor 1
                        full = bf.anova(tbl,'response~fac1+subject','scale',scale,'treatAsRandom',{'subject'});
                        restricted = bf.anova(tbl,'response~subject','scale',scale,'treatAsRandom',{'subject'});
                        bayesFactor(j,i) = full/restricted;
                        lm =fitlme(tbl,'response~fac1+(1|subject)');
                        tmp =anova(lm);
                        pValue(j,i) =tmp.pValue(2); % pValue of the Main factor
                        stat(j,i) = tmp.FStat(2);
                        df1 = levels(1)-1;
                        df2 = df1*(sampleSizes(j)-1);
                        bayesFactorBIC(j,i) = bf.bfFromF( stat(j,i),df1,df2,sampleSizes(j));

                    case '2WAYRMINT'
                        % Interaction effect
                        full = bf.anova(tbl,'response~fac1*fac2+subject','scale',scale,'treatAsRandom',{'subject'});
                        restricted = bf.anova(tbl,'response~fac1+fac2+subject','scale',scale,'treatAsRandom',{'subject'});
                        bayesFactor(j,i) = full/restricted;
                        lm =fitlme(tbl,'response~fac1*fac2+(1|subject)');
                        tmp =anova(lm);
                        pValue(j,i) =tmp.pValue(end); % pValue of the Main factor
                        stat(j,i) = tmp.FStat(end);
                        df1 = prod(levels-1);
                        % df error for repeated measures: total-within-subjects
                        df2 = df1*(sampleSizes(j)-1);
                        bayesFactorBIC(j,i) = bf.bfFromF(stat(j,i),df1,df2,sampleSizes(j));
                end
                nn = showTimeToCompletion(((i-1)*nrSampleSizes+j)/(nrSimulatedExperiments*nrSampleSizes),nn);
            end
            %             consistency =100*mean(sign(log10(bayesFactor(j,:)))==sign(log10(bayesFactorBIC(j,:))));
            %             sprintf('%.2f %.2f %.2f %.2f %.2f %%',effectSize(1),min(log10(bayesFactor(:,j))),nanmedian(log10(bayesFactor(:,j))),max(log10(bayesFactor(:,j))),consistency)
            %             sprintf('%.2f %.2f %.2f %.2f %.2f %%',effectSize(1),min(log10(bayesFactorBIC(:,j))),nanmedian(log10(bayesFactorBIC(:,j))),max(log10(bayesFactorBIC(:,j))),consistency)
        end

end

%% Generate a figure
% 1 - compare pValue with BF
% 2 - compare stat (F or T) with BF
% 3 -  compare BIC approximation with BF

figure;clf
minP = 1e-4;
maxP = 0.1;
h = nan(nrSampleSizes,1);
xtick = sort([10.^(-3:1:-1) 0.05]);
for j = 1:nrSampleSizes
    subplot(2,2,1);
    x = pValue(j,:,:);
    [x,ix]=sort(x(:));
    y = bayesFactor(j,:,:);
    y=y(ix);
    h(j)= plot(x,y(:),'.-');
    set(gca,'YScale','Log','YLim',[0 1000],'XScale','log','XLim',[minP maxP],'XTIck',xtick);
    hold on
    subplot(2,2,2);
    x = stat(j,:,:);
    [x,ix]=sort(x(:));
    y = bayesFactor(j,:,:);
    y=y(ix);
    h(j)= plot(x,y(:),'.-');
    set(gca,'YScale','Log','YLim',[0 1000]);%,'XScale','log','XLim',[minP maxP],'XTIck',xtick);
    hold on
end
subplot(2,2,1)
plot(xlim,[1 1],'k--'); text(maxP,1,'Equal','Color','k')
plot(xlim,[3 3],'r--'); text(maxP,3,'Barely','Color','r')
plot(xlim,[6 6],'g--');text(maxP,6,'Moderate','Color','g')
plot(xlim,[10 10],'b--');text(maxP,10,'Strong','Color','b')
ylabel 'Bayes Factor'
xlabel 'p-Value'
title (['Simulating: ' testToSimulate])
bfLim =ylim;  % Take the bf limits that go with the p-limits we imposed
legend(h,num2str(sampleSizes'))
subplot(2,2,2);
plot(xlim,[1 1],'k--'); text(maxP,1,'Equal','Color','k')
plot(xlim,[3 3],'r--'); text(maxP,3,'Barely','Color','r')
plot(xlim,[6 6],'g--');text(maxP,6,'Moderate','Color','g')
plot(xlim,[10 10],'b--');text(maxP,10,'Strong','Color','b')
ylabel 'Bayes Factor'
xlabel 'Test Statistic (T/F)'
legend(h,num2str(sampleSizes'))

subplot(2,2,3)
for j = 1:nrSampleSizes
    x = bayesFactor(j,:,:);
    y = bayesFactorBIC(j,:,:);
    plot(x(:),y(:),'.');
    hold on
end
axis square
axis equal
ylabel 'BIC approximation'
xlabel 'Bayes Factor'
set(gca,'XScale','log','YScale','Log','XLim',bfLim,'YLim',bfLim);
plot(bfLim,bfLim,'k--')
title 'Comparing BF with BIC Approximation'


function MS = createMeshSpherical1D(varargin)
% MeshStructure = createMeshSpherical1D(Nr, Lr)
% MeshStructure = createMeshSpherical1D(facelocationR)
% creates a uniform 1D mesh (1D axial symmetry):
% Nx is the number of cells in r (radial) direction
% Width is the domain radius in r direction
%
% SYNOPSIS:
%   MeshStructure = createMeshSpherical1D(Nr, Lr)
%
% PARAMETERS:
%   Nr: number of cells in the domain
%   Lr: domain radius
%
% RETURNS:
%   MeshStructure.
%                 dimensions=1.5 (1D axial symmetry)
%                 numbering: shows the indexes of cellsn from left to right
%                 dx: cell size (=Lr/Nx)
%                 cellcenters.x: location of each cell in the x direction
%                 facecenters.x: location of interface between cells in the
%                 r direction
%                 numberofcells: Nr
%
%
% EXAMPLE:
%   R = 1.0; % length of the domain
%   Nr = 10; % number of cells in the domain
%   m = createMeshCylindrical1D(Nr, R);
%   plot(m.cellcenters.x, ones(size(m.cellcenters.x)), 'o', ...
%        m.facecenters.x, ones(size(m.facecenters.x)), '-+');
%   legend('cell centers', 'face centers');
%
% SEE ALSO:
%     createMesh1D, createMesh2D, createMesh3D, ...
%     createMeshCylindrical2D, createCellVariable, createFaceVariable

% Written by Ali A. Eftekhari
% See the license file

if nargin==2
  % uniform 1D mesh
  Nr=varargin{1};
  R=varargin{2};
  % cell size is dx
  dx = R/Nr;
  CellSize.x= dx*ones(Nr+2,1);
  CellSize.y= [0.0];
  CellSize.z= [0.0];
  CellLocation.x= [1:Nr]'*dx-dx/2;
  CellLocation.y= [0.0];
  CellLocation.z= [0.0];
  FaceLocation.x= [0:Nr]'*dx;
  FaceLocation.y= [0.0];
  FaceLocation.z= [0.0];
elseif nargin==1
  % nonuniform 1D mesh
  facelocationR=varargin{1};
  n=size(facelocationR);
  if n(1)==1
      facelocationR=facelocationR';
  end
  Nr = length(facelocationR)-1;
  CellSize.x= [facelocationR(2)-facelocationR(1); ...
    facelocationR(2:end)-facelocationR(1:end-1); ...
    facelocationR(end)-facelocationR(end-1)];
  CellSize.y= [0.0];
  CellSize.z= [0.0];
  CellLocation.x= 0.5*(facelocationR(2:end)+facelocationR(1:end-1));
  CellLocation.y= [0.0];
  CellLocation.z= [0.0];
  FaceLocation.x= facelocationR;
  FaceLocation.y= [0.0];
  FaceLocation.z= [0.0];
end

MS=MeshStructure(1.8, ...
  [Nr,1], ...
  CellSize, ...
  CellLocation, ...
  FaceLocation, ...
  [1], ...
  [1]);


function h = p30_h ( n, x )

%*****************************************************************************80
%
%% P30_H evaluates the Hessian for problem 30.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 January 2001
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of variables.
%
%    Input, real X(N), the values of the variables.
%
%    Output, real H(N,N), the N by N Hessian matrix.
%
  h = zeros ( n, n );

  a = 1.0;
  d = 6.0;
  e = 10.0;

  b = 5.1 / ( 4.0 * pi^2 );
  c = 5.0 / pi;
  ff = 1.0 / ( 8.0 * pi );

  h(1,1) = 2.0 * a * ( - 2.0 * b * x(1) + c ) ...
    * ( - 2.0 * b * x(1) + c ) ...
    - 4.0 * a * b * ( x(2) - b * x(1)^2 + c * x(1) - d ) ...
    - e * ( 1.0 - ff ) * cos ( x(1) );

  h(1,2) = 2.0 * a * ( - 2.0 * b * x(1) + c );

  h(2,1) = 2.0 * a * ( - 2.0 * b * x(1) + c );
  h(2,2) = 2.0 * a;

  return
end


function phi = basis_brick20 ( n, p )

%*****************************************************************************80
%
%% BASIS_BRICK20: BRICK20 basis functions at natural coordinates.
%
%  Discussion:
%
%        8----19---7
%       /|        /|
%     20 |      18 |        t   s
%     /  16     /  15       |  /
%    5----17---6   |        | /
%    |   |     |   |        |/
%    |   4--11-|---3        0---------r
%   13  /     14  /
%    | 12      | 10
%    |/        |/
%    1----9----2
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 March 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real P(3,N), natural coordinates of evaluation points.
%
%    Output, real PHI(20,N), the basis function values.
%
  phi(1,1:n) = ...
    ( 1.0 - p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) ...
    .* ( - p(1,1:n) - p(2,1:n) - p(3,1:n) - 2.0 ) / 8.0;
  phi(2,1:n) = ...
    ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) ...
    .* ( + p(1,1:n) - p(2,1:n) - p(3,1:n) - 2.0 ) / 8.0;
  phi(3,1:n) = ...
    ( 1.0 + p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) ...
    .* ( + p(1,1:n) + p(2,1:n) - p(3,1:n) - 2.0 ) / 8.0;
  phi(4,1:n) = ...
    ( 1.0 - p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) ...
    .* ( - p(1,1:n) + p(2,1:n) - p(3,1:n) - 2.0 ) / 8.0;
  phi(5,1:n) = ...
    ( 1.0 - p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) ...
    .* ( - p(1,1:n) - p(2,1:n) + p(3,1:n) - 2.0 ) / 8.0;
  phi(6,1:n) = ...
    ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) ...
    .* ( + p(1,1:n) - p(2,1:n) + p(3,1:n) - 2.0 ) / 8.0;
  phi(7,1:n) = ...
    ( 1.0 + p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) ...
    .* ( + p(1,1:n) + p(2,1:n) + p(3,1:n) - 2.0 ) / 8.0;
  phi(8,1:n) = ...
    ( 1.0 - p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) ...
    .* ( - p(1,1:n) + p(2,1:n) + p(3,1:n) - 2.0 ) / 8.0;

  phi(9,1:n) =  ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(1,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(10,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(11,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(1,1:n) ) ...
              .* ( 1.0 + p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(12,1:n) = ( 1.0 - p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(13,1:n) = ( 1.0 - p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) ...
              .* ( 1.0 + p(3,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(14,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(2,1:n) ) ...
              .* ( 1.0 + p(3,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(15,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 + p(3,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(16,1:n) = ( 1.0 - p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 + p(3,1:n) ) .* ( 1.0 - p(3,1:n) ) / 4.0;
  phi(17,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(1,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) / 4.0;
  phi(18,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) / 4.0;
  phi(19,1:n) = ( 1.0 + p(1,1:n) ) .* ( 1.0 - p(1,1:n) ) ...
              .* ( 1.0 + p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) / 4.0;
  phi(20,1:n) = ( 1.0 - p(1,1:n) ) .* ( 1.0 + p(2,1:n) ) ...
              .* ( 1.0 - p(2,1:n) ) .* ( 1.0 + p(3,1:n) ) / 4.0;

  return
end


function X=JumpDiffusionKou(m,s,l,p,e1,e2,ts,J)

T=ts(end);
% simulate number of jumps
N=poissrnd(l*T,J,1);

Jumps=[];
L=length(ts);
for j=1:J
    % simulate jump arrival time
    t=T*rand(N(j),1);
    t=sort(t);

    % simulate jump size
    ww=binornd(1,p,N(j),1);
    S=ww.*exprnd(e1,N(j),1)-(1-ww).*exprnd(e2,N(j),1);

    % put things together
    CumS=cumsum(S);
    for n=1:L
        Events=sum(t<=ts(n));
        Jumps_ts(n)=0;
        if Events
            Jumps_ts(n)=CumS(Events);
        end
    end

    Jumps=[Jumps
        Jumps_ts];
end
for l=1:L
    Dt=ts(l);
    if l>1
        Dt=ts(l)-ts(l-1);
    end
    D_Diff(:,l)=m*Dt + s*sqrt(Dt)*randn(J,1);
end

X=[zeros(J,1) cumsum(D_Diff,2)+Jumps];


%% design path from points by spline

point = [0, 0;
    1, 0;
    2,0
    3,0.5
    4,1.5
    4.8, 1.5
    5,0.8
    6, 0.5
    6.5, 0
    7.5, 0.5
    7,2
    6, 3
    5, 4
    4., 2.5
    3, 3
    2., 3.5;
    1.3, 2.2
    0.5, 2.
    0,3];

s = 1:1:length(point);

px_spline = spline(s, point(:,1), 1:0.01:length(point));
py_spline = spline(s, point(:,2), 1:0.01:length(point));

p_spline = [px_spline', py_spline'];

%% insert yaw

yaw = zeros(length(px_spline), 1);
for i = 2:length(px_spline)-1
    x_forward = px_spline(i+1);
    x_backward = px_spline(i-1);
    y_forward = py_spline(i+1);
    y_backward = py_spline(i-1);
    yaw(i) = atan2(y_forward-y_backward, x_forward-x_backward);
end
yaw(1) = yaw(2);
yaw(end) = yaw(end-1);

%% plot with attitude

arrow_scale = 0.01;

figure(101);
plot(point(:,1), point(:,2), 'bo-'); hold on;
quiver(px_spline', py_spline', cos(yaw)*arrow_scale, sin(yaw)*arrow_scale);
plot(px_spline, py_spline,'r-'); grid on; hold off;

%% save path
path = [px_spline', py_spline', yaw];

save('path', 'path')


function [out] = saturation_7(p1,p2,p3,p4,p5,S,In)
%saturation_7

% Copyright (C) 2019, 2021 Wouter J.M. Knoben, Luca Trotter
% This file is part of the Modular Assessment of Rainfall-Runoff Models
% Toolbox (MARRMoT).
% MARRMoT is a free software (GNU GPL v3) and distributed WITHOUT ANY
% WARRANTY. See <https://www.gnu.org/licenses/> for details.

% Flux function
% ------------------
% Description:  Saturation excess from a store with different degrees of
%               saturation (gamma function variant)
% Constraints:  f = 0, for x-p3 < 0
%               S >= 0      prevents numerical problems with integration
% @(Inputs):    p1   - scaling parameter [-]
%               p2   - gamma function parameter [-]
%               p3   - storage threshold for flow generation [mm]
%               p4   - absolute scaling parameter [mm]
%               p5   - linear scaling parameter [-]
%               S    - current storage [mm]
%               In   - incoming flux [mm/d]

out = integral(@(x)...
        1./(p1.*gamma(p2)).*(max(x-p3,0)./p1).^(p2-1).*exp(-1.*max(x-p3,0)./p1),...
        p5.*max(S,0)+p4,Inf).*In;

end


%minmax - Show min and max values for any number of variables.
%
%  USAGE
%
%    minmax(x,y,...)
%
%    x,y,...        variables
%

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

function minmax_FMAT(varargin)

if nargin < 1,
  error('Incorrect number of parameters (type ''help minmax'' for details).');
end

for i = 1:length(varargin),
	str = '';
	% Variable index (min)
	str = [str '   [' int2str(i) '-] '];
	% Variable values (min)
	s = min(varargin{i});
	for j = 1:length(s),
		str = [str num2str(s(j)) ' '];
	end
	str(end) = [];
	disp(str);
	str = '';
	% Variable index (max)
	str = [str '   [' int2str(i) '+] '];
	% Variable values (max)
	s = max(varargin{i});
	for j = 1:length(s),
		str = [str num2str(s(j)) ' '];
	end
	str(end) = [];
	disp(str);
end


function [VEC,C,V,E] = prtUtilPca(DATA,P)
%[VEC,C,V,E] = getPcaVec(DATA,P);
% xxx Need Help xxx
%

%Peter Torrione
C = cov(DATA);
[V,E] = eig(C);

%sort
[E,IND] = sort(abs(diag(E)));
%re-sorta
E = flipud(E(:));
IND = flipud(IND(:));
V = V(:,IND);

if P < 1
    NRG = cumsum(E)./sum(E);
    NRGind = find(NRG > P,1,'first');
    VEC = V(:,1:NRGind);
else
    VEC = V(:,1:P);
end

PLOTTING = 0;
if PLOTTING
    plot(DATA'./max(abs(DATA(:))));
    hold on;
    h = plot(VEC./max(abs(VEC(:))));
    set(h,'linewidth',3);
    pause
    close all;
end


function beep2(w,t)
%plays a short tone as an audible cue
%
%USAGE:
%    beep2
%    beep2(w)    specify frequency (200-1,000 Hz)
%    beep2(w,t)     "       "       and duration in seconds

fs=8192;  %sample freq in Hz

if (nargin == 0)
   w=1000;            %default
   t = [0:1/fs:.2];   %default
elseif (nargin == 1)
   t = [0:1/fs:.2];   %default
elseif (nargin == 2)
   t = [0:1/fs:t];
end

%one possible wave form
wave=sin(2*pi*w*t);

%play sound
sound(wave,fs);


function m = curveMoment(curve, p, q)
%CURVEMOMENT  Compute inertia moment of a 2D curve
%   M = curveMoment(CURVE, P, Q)
%
%   Example
%   curveMoment
%
%   See also
%   polygons2d, curveCMoment, curveCSMoment
%
%   Reference
%   Based on ideas and references in:
%   "Affine curve moment invariants for shape recognition"
%   Dongmin Zhao and Jie Chen
%   Pattern Recognition, 1997, vol. 30, pp. 865-901
%
%
% ------
% Author: David Legland
% e-mail: david.legland@grignon.inra.fr
% Created: 2009-03-25,    using Matlab 7.7.0.471 (R2008b)
% Copyright 2009 INRA - Cepia Software Platform.

% coordinate of vertices
px  = curve(:,1);
py  = curve(:,2);

% compute centroids of line segments
cx  = (px(1:end-1)+px(2:end))/2;
cy  = (py(1:end-1)+py(2:end))/2;

% compute length of each line segment
dl  = hypot(px(2:end)-px(1:end-1), py(2:end)-py(1:end-1));

% compute moment
m = zeros(size(p));
for i=1:length(p(:))
    m(i) = sum(cx(:).^p(i) .* cy(:).^q(i) .* dl(:));
end


[ H, ok, score ] = HM_ransac(X1, X2, 500, 0.1);

figure; clf;
marker_size = 15;
imshow([im1,im2], 'border', 'tight'); hold on;
plot(X1(1,ok), X1(2,ok), 'b.', 'MarkerSize', marker_size);
plot(X2(1,ok)+imsize1(2), X2(2,ok), 'b.', 'MarkerSize', marker_size);
plot(X1(1,~ok), X1(2,~ok), 'r.', 'MarkerSize', marker_size);
plot(X2(1,~ok)+imsize1(2), X2(2,~ok), 'r.', 'MarkerSize', marker_size);

% h = line([X1(1,ok) ; X2(1,ok)+imsize1(2)], [X1(2,ok) ; X2(2,ok)], 'LineWidth', 2) ;

X1_ok = X1(:,ok);
X2_ok = X2(:,ok);

% bundle adjustment on the normallized matching data
options = optimoptions('lsqnonlin', 'Algorithm','levenberg-marquardt', 'Display','final',...
    'MaxFunEvals',2000, 'MaxIter',1e3, 'TolFun',1e-6, 'TolX',1e-6, 'Jacobian','off');
[paras_init,resnorm_init,residual_init,exitflag_init,output_init] = lsqnonlin(...
    @(p)residual_KR_robust(double(X1_ok), double(X2_ok), imsize1, imsize2, p, 1000), [1000 1000 0 0 0],...
    [],[],options);
[paras,resnorm,residual,exitflag,output] = lsqnonlin(...
    @(p)residual_KR_robust(double(X1_ok), double(X2_ok), imsize1, imsize2, p, 10), paras_init,...
    [],[],options);
k1 = paras(1);
k2 = paras(2);
theta = paras(3:5);

K1 = [k1, 0, imsize1(2)/2;
     0, k1, imsize1(1)/2;
     0,  0, 1];
K2 = [k2, 0, imsize2(2)/2;
      0, k2, imsize2(1)/2;
      0,  0, 1];
theta_m = [0         -theta(3) theta(2)
           theta(3)  0         -theta(1)
           -theta(2) theta(1)  0];
R = expm(theta_m);

H = K2*R/K1;
M1 = K1; M2 = K2; D1 = 0; D2 = 0;


function err = test_factorize (A)
%TEST_FACTORIZE test the accuracy of the factorization object
%
% Example
%   test_factorize (A) ;    % where A is a square matrix (sparse or dense)
%
% See also test_all, factorize1, factorize, inverse, mldivide

% Copyright 2009, Timothy A. Davis, University of Florida

if (nargin < 1)
    A = rand (100) ;
end

[m n] = size (A) ;
err = 0 ;
if (min (m,n) > 0)
    anorm = norm (A,1) ;
else
    anorm = 1 ;
end

for nrhs = 1:3

    for bsparse = 0:1

        % fprintf ('n %4d nrhs %d bsparse %d : ', n, nrhs, bsparse) ;

        b = rand (m,nrhs) ;
        if (bsparse)
            b = sparse (b) ;
        end

        %------------------------------------------------------------------
        % test backslash and related methods
        %------------------------------------------------------------------

        % method 0:
        x = A\b ;           err = check_resid (err, anorm, A, x, b) ;

        % method 1:
        S = inverse (A) ;
        x = S*b ;           err = check_resid (err, anorm, A, x, b) ;

        % method 2:
        if (m == n)
            F = factorize1 (A) ;
            x = F\b ;       err = check_resid (err, anorm, A, x, b) ;
        end

        % method 3:
        if (m == n)
            S = inverse (F) ;
            x = S*b ;       err = check_resid (err, anorm, A, x, b) ;
        end

        % method 4:
        F = factorize (A) ;
        x = F\b ;           err = check_resid (err, anorm, A, x, b) ;

        % method 5:
        S = inverse (F) ;
        x = S*b ;           err = check_resid (err, anorm, A, x, b) ;

        % method 6:
        if (m == n)
            [L,U,p] = lu (A, 'vector') ;
            x = U \ (L \ (b (p,:))) ;
            err = check_resid (err, anorm, A, x, b) ;
        end

        % method 7 (ack!)
        if (m == n)
            S = inv (A) ;
        else
            S = pinv (full (A)) ;
            if (issparse (A))
                S = sparse (S) ;
            end
        end
        x = S*b ;           err = check_resid (err, anorm, A, x, b) ;

        %------------------------------------------------------------------
        % test mtimes
        %------------------------------------------------------------------

        S = inverse (F) ;
        d = rand (n,1) ;
        x = F*d ;
        y = A*d ;
        z = S\d ;
        e = max (norm (x-y,1), norm (x-z,1)) ;
        if (e > 0)
            error ('mtimes error') ;
        end

        if (m == n)
            F = factorize1 (A) ;
            S = inverse (F) ;
            d = rand (n,1) ;
            x = F*d ;
            y = A*d ;
            z = S\d ;
            e = max (norm (x-y,1), norm (x-z,1)) ;
            if (e > 0)
                error ('mtimes error') ;
            end
        end

        %------------------------------------------------------------------
        % test slash and related methods
        %------------------------------------------------------------------

        b = rand (nrhs,n) ;
        if (bsparse)
            b = sparse (b) ;
        end

        % method 0:
        x = b/A ;           err = check_resid (err, anorm, A, x, b, 1) ;

        % method 1:
        S = inverse (A) ;
        x = b*S ;           err = check_resid (err, anorm, A, x, b, 1) ;

        % method 2:
        if (m == n)
            F = factorize1 (A) ;
            x = b/F ;       err = check_resid (err, anorm, A, x, b, 1) ;
        end

        % method 3:
        if (m == n)
            S = inverse (F) ;
            x = b*S ;       err = check_resid (err, anorm, A, x, b, 1) ;
        end

        % method 4:
        F = factorize (A) ;
        x = b/F ;           err = check_resid (err, anorm, A, x, b, 1) ;

        % method 5:
        S = inverse (F) ;
        x = b*S ;           err = check_resid (err, anorm, A, x, b, 1) ;

        % method 6:
        if (m == n)
            [L,U,p] = lu (A, 'vector') ;
            x = (b / U) / L ; x (:,p) = x ;
            err = check_resid (err, anorm, A, x, b, 1) ;
        end

        % method 7 (ack!)
        if (m == n)
            S = inv (A) ;
        else
            S = pinv (full (A)) ;
            if (issparse (A))
                S = sparse (S) ;
            end
        end
        x = b*S ;           err = check_resid (err, anorm, A, x, b, 1) ;

        %------------------------------------------------------------------
        % test double
        %------------------------------------------------------------------

        Y = double (inverse (A)) ;
        if (m == n)
            Z = inv (A) ;
        else
            Z = pinv (full (A)) ;
        end
        e = norm (Y-Z,1) ;
        if (n > 0)
            e = e / norm (Z,1) ;
        end
        err = max (e, err) ;

        %------------------------------------------------------------------
        % test subsref
        %------------------------------------------------------------------

        F = factorize (A) ;
        Y = inverse (A) ;
        if (numel (A) > 1)
            if (F (end) ~= A (end))
                error ('factorization subsref error') ;
            end
            if (F.A (end) ~= A (end))
                error ('factorization subsref error') ;
            end
        end
        if (n > 0)
            if (F (1,1) ~= A (1,1))
                error ('factorization subsref error') ;
            end
            if (F.A (1,1) ~= A (1,1))
                error ('factorization subsref error') ;
            end
            e = abs (Y (1,1) - Z (1,1)) ;
            err = max (e,err) ;
            if (m > 1 && n > 1)
                e = norm (Y (1:2,1:2) - Z (1:2,1:2), 1) ;
                err = max (e,err) ;
            end
        end
        if (m > 3 && n > 1)
            if (any (F (2:end, 1:2) - A (2:end, 1:2)))
                error ('factorization subsref error') ;
            end
            if (any (F (2:4, :) - A (2:4, :)))
                error ('factorization subsref error') ;
            end
            if (any (F (:, 1:2) - A (:, 1:2)))
                error ('factorization subsref error') ;
            end
        end

        %------------------------------------------------------------------
        % test update/downdate
        %------------------------------------------------------------------

        if (isa (F, 'factorization_dense_chol'))
            w = rand (n,1) ;
            b = rand (n,1) ;
            % update
            G = F + w ;
            x = G\b ;       err = check_resid (err, anorm, A+w*w', x, b) ;
            % downdate
            G = G - w ;
            x = G\b ;       err = check_resid (err, anorm, A, x, b) ;
            clear G
        end

        %------------------------------------------------------------------
        % test size
        %------------------------------------------------------------------

        [m1 n1] = size (F) ;
        [m n] = size (A) ;
        if (m1 ~= m || n1 ~= n)
            error ('size error') ;
        end
        [m1 n1] = size (Y) ;
        if (m1 ~= n || n1 ~= m)
            error ('pinv size error') ;
        end
        if (size (Y,1) ~= n || size (Y,2) ~= m)
            error ('pinv size error') ;
        end
        if (size (F,1) ~= m || size (F,2) ~= n)
            error ('size error') ;
        end

        %------------------------------------------------------------------
        % test mtimes
        %------------------------------------------------------------------

        d = rand (1,m) ;
        x = d*F ;
        y = d*A ;
        z = d/Y ;
        e = max (norm (x-y,1), norm (x-z,1)) ;
        if (e > 0)
            error ('mtimes error') ;
        end

        if (m == n)
            F = factorize1 (A) ;
            Y = inverse (F) ;
            d = rand (1,m) ;
            x = d*F ;
            y = d*A ;
            z = d/Y ;
            e = max (norm (x-y,1), norm (x-z,1)) ;
            if (e > 0)
                error ('mtimes error') ;
            end
        end

        %------------------------------------------------------------------
        % test inverse
        %------------------------------------------------------------------

        Y = double (inverse (inverse (A))) ;
        e = norm (A-Y,1) ;
        if (e > 0)
            error ('inverse error') ;
        end

    end
end

fprintf ('.') ;

if (err > 1e-8)
    fprintf ('error: %8.3e\n', err) ;
    error ('error is too high!') ;
end

%--------------------------------------------------------------------------

function err = check_resid (err, anorm, A, x, b, transposed)
if (nargin < 6)
    transposed = 0 ;
end
[m n] = size (A) ;

if (transposed)
    if (m >= n)
        e = norm (A'*x'-b',1) / (anorm + norm (x,1)) ;
    else
        e = norm (A*(A'*x')-A*b',1) / (anorm + norm (x,1)) ;
    end
else
    if (m <= n)
        e = norm (A*x-b,1) / (anorm + norm (x,1)) ;
    else
        e = norm (A'*(A*x)-A'*b,1) / (anorm + norm (x,1)) ;
    end
end

if (min (m,n) > 1)
    if (issparse (A) && issparse (b))
        if (~issparse (x))
            error ('x must be sparse') ;
        end
    else
        if (issparse (x))
            error ('x must be full') ;
        end
    end
end
err = max (err, e) ;


function [Ynorm, Ymean] = normalizeRatings(Y, R)
%NORMALIZERATINGS Preprocess data by subtracting mean rating for every
%movie (every row)
%   [Ynorm, Ymean] = NORMALIZERATINGS(Y, R) normalized Y so that each movie
%   has a rating of 0 on average, and returns the mean rating in Ymean.
%

[m, n] = size(Y);
Ymean = zeros(m, 1);
Ynorm = zeros(size(Y));
for i = 1:m
    idx = find(R(i, :) == 1);
    Ymean(i) = mean(Y(i, idx));
    Ynorm(i, idx) = Y(i, idx) - Ymean(i);
end

end


function [ yv, yvp ] = hermite_interpolant_value ( nd, xd, yd, xdp, ydp, nv, ...
  xv )

%*****************************************************************************80
%
%% HERMITE_INTERPOLANT_VALUE evaluates the Hermite interpolant polynomial.
%
%  Discussion:
%
%    In fact, this function will evaluate an arbitrary polynomial that is
%    represented by a difference table.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    31 October 2011
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Carl deBoor,
%    A Practical Guide to Splines,
%    Springer, 2001,
%    ISBN: 0387953663,
%    LC: QA1.A647.v27.
%
%  Parameters:
%
%    Input, integer ND, the order of the difference table.
%
%    Input, real XD(ND), YD(ND), the difference table for the
%    interpolant value.
%
%    Input, real XDP(ND-1), YDP(ND-1), the difference table for
%    the interpolant derivative.
%
%    Input, integer NV, the number of evaluation points.
%
%    Input, real XV(NV), the evaluation points.
%
%    Output, real YV(NV), YVP(NV), the value of the interpolant and
%    its derivative at the evaluation points.
%
  ndp = nd - 1;
%
%  Clearly MATLAB is going to be all prissy about combining
%  vectors and scalars and wants me to use repmat or something
%  nonintuitive if I want to vectorize this loop and I say
%  it's spinach and to hell with it.
%
  for j = 1 : nv

    yv(j) = yd(nd);
    for i = nd - 1 : -1 : 1
      yv(j) = yd(i) + ( xv(j) - xd(i) ) * yv(j);
    end

    yvp(j) = ydp(ndp);
    for i = ndp - 1 : -1 : 1
      yvp(j) = ydp(i) + ( xv(j) - xdp(i) ) * yvp(j);
    end

  end

  return
end


function fx = quartic ( x )

%*****************************************************************************80
%
%% QUARTIC evaluates a function defined by a sum of fourth powers.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 February 2008
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    R ONeill,
%    Algorithm AS 47:
%    Function Minimization Using a Simplex Procedure,
%    Applied Statistics,
%    Volume 20, Number 3, 1971, pages 338-345.
%
%  Parameters:
%
%    Input, real X(10), the argument.
%
%    Output, real FX, the value of the function.
%
  fx = sum ( x(1:10).^4 );

  return
end


function [elon, elat] = eqecl (tjd, icoord, ra, dec)

% this function converts right ascension and declination
% to ecliptic longitude and latitude

% input

%  tjd    = tt julian date of equator, equinox, and ecliptic
%           used for coordinates

%  icoord = coordinate system selection

%               set icoord = 0 for mean equator and equinox of date
%               set icoord = 1 for true equator and equinox of date

%               (ecliptic is always the mean plane)

%  ra     = right ascension in hours, referred to specified
%           equator and equinox of date

%  dec    = declination in degrees, referred to specified
%           equator and equinox of date

% output

%  elon = ecliptic longitude in degrees, referred to specified
%         ecliptic and equinox of date

%  elat = ecliptic latitude in degrees, referred to specified
%         ecliptic and equinox of date

% note:  to convert icrs ra and dec to ecliptic coordinates (mean
% ecliptic and equinox of j2000.0), set tjd = 0.d0 and icoord = 0.
% except for the input to this case, all coordinates are dynamical.

% ported from NOVAS3.0

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

radcon = pi / 180.0d0;

% form position vector in equatorial system from input coordinates

r = ra * 15.0d0 * radcon;

d = dec * radcon;

pos1(1) = cos(d) * cos(r);

pos1(2) = cos(d) * sin(r);

pos1(3) = sin(d);

% convert the vector from equatorial to ecliptic system

pos2 = eqec (tjd, icoord, pos1);

% decompose ecliptic vector into ecliptic longitude and latitude

xyproj = sqrt(pos2(1)^2 + pos2(2)^2);

e = 0.0d0;

if (xyproj > 0.0d0)
    e = atan2 (pos2(2), pos2(1));
end

elon = e / radcon;

if (elon < 0.0d0)
    elon = elon + 360.0d0;
end

e = atan2 (pos2(3), xyproj);

elat = e / radcon;


function [N,E,Zone,lcm]=ell2utm(lat,lon,a,e2,lcm)
% ELL2UTM  Converts ellipsoidal coordinates to UTM coordinates.
%   UTM northing and easting coordinates must be in a 6 degree
%   system. Zones begin with zone 1 at longitude 180E to 186E
%   and increase eastward.  Formulae from E.J. Krakiwsky,
%   "Conformal Map Projections in Geodesy", Dept. Surveying
%   Engineering Lecture Notes No. 37, University of New Brunswick,
%   Fredericton, N.B, 1973. Krakwisky meridian arc length (S)
%   replaced with Hermert (1880) expansion. Vectorized.
% Version: 2011-11-13
% Useage:  [N,E,Zone,lcm]=ell2utm(lat,lon,a,e2,lcm)
%          [N,E,Zone,lcm]=ell2utm(lat,lon,a,e2)
%          [N,E,Zone,lcm]=ell2utm(lat,lon,lcm)
%          [N,E,Zone,lcm]=ell2utm(lat,lon)
% Input:   lat - vector of latitudes (rad)
%          lon - vector of longitudes (rad)
%          a   - optional ref. ellipsoid major semi-axis (m);
%                default GRS80
%          e2  - optional ref. ellipsoid eccentricity squared;
%                default GRS80
%          lcm - optional vector of non-standard central meridians
%                (rad); scalar if same for all; default = UTM def'n
% Output:  N   - vector of UTM northings (m)
%          E   - vector of UTM eastings (m)
%          Zone- vector of UTM zones (zeros if lcm specified)
%          lcm - central meridian(s) used in conversion (rad)

% Copyright (c) 2011, Michael R. Craymer
% All rights reserved.
% Email: mike@craymer.com

if nargin ~= 2 & nargin ~= 3 & nargin ~= 4 & nargin ~= 5
  warning('Incorrect number of input arguments');
  return
end

if nargin == 3
  lcm=a;
end
if nargin == 2 | nargin == 3
  [a,b,e2,finv]=refell('grs80');
  f=1/finv;
else
  f=1-sqrt(1-e2);
end
if nargin == 3 | nargin==5
  Zone=zeros(size(lat));
else
  Zone=floor((rad2deg(lon)-180)/6)+1;
  Zone=Zone+(Zone<0)*60-(Zone>60)*60;
  lcm=deg2rad(Zone*6-183);
end

if abs(lat)>deg2rad(80)
  warning('Latitude outside 80N/S limit for UTM');
end

ko=0.9996;           % Scale factor
No=zeros(size(lat)); % False northing (north)
No(lat<0)=1e7;       % False northing (south)
Eo=500000;           % False easting

lam=lon-lcm;
lam=lam-(lam>=pi)*(2*pi);

RN=a./(1-e2*sin(lat).^2).^0.5;
RM=a*(1-e2)./(1-e2*sin(lat).^2).^1.5;
h2=e2*cos(lat).^2/(1-e2);
t=tan(lat);
n=f/(2-f);

%----- Hinks (1927) Bessel series expansion used in DMA definition of UTM
%A0=1 - n + n.^2*5/4 - n.^3*5/4 + n.^4*81/64 - n.^5*81/64;
%A2=3/2*( n - n.^2 + n.^3*7/8 - n.^4*7/8 + n.^5*55/64 );
%A4=15/16*( n.^2 - n.^3 + n.^4*3/4 - n.^5*3/4 );
%A6=35/48*( n.^3 - n.^4 + n.^5*11/16 );
%A8=315/512*( n.^4 - n.^5 );
%S=a*(A0*lat-A2*sin(2*lat)+A4*sin(4*lat)-A6*sin(6*lat)+A8*sin(8*lat));

%----- Helmert (1880) expansion & simplification of Bessel series (faster)
A0=1+n^2/4+n^4/64;
A2=3/2*(n-n^3/8);
A4=15/16*(n^2-n^4/4);
A6=35/48*n^3;
A8=315/512*n^4;
S=a/(1+n)*(A0*lat-A2*sin(2*lat)+A4*sin(4*lat)-A6*sin(6*lat)+A8*sin(8*lat));

%----- Krakiwsky (1973) expansion
%A0=1-(e2/4)-(e2^2*3/64)-(e2^3*5/256)-(e2^4*175/16384);
%A2=(3/8)*( e2+(e2^2/4)+(e2^3*15/128)-(e2^4*455/4096) );
%A4=(15/256)*( e2^2+(e2^3*3/4)-(e2^4*77/128) );
%A6=(35/3072)*( e2^3-(e2^4*41/32) );
%A8=-(315/131072)*e2^4;
%S=a*(A0*lat-A2*sin(2*lat)+A4*sin(4*lat)-A6*sin(6*lat)+A8*sin(8*lat));

E1=lam.*cos(lat);
E2=lam.^3.*cos(lat).^3/6*(1-t.^2+h2);
E3=lam.^5.*cos(lat).^5/120.*(5-18*t.^2+t.^4+14*h2-58*t.^2.*h2+ ...
   13*h2.^2+4*h2.^3-64*t.^2.*h2.^2-24*t.^2.*h2.^3);
E4=lam.^7.*cos(lat).^7/5040.*(61-479*t.^2+179*t.^4-t.^6);
E=Eo+ko*RN.*(E1+E2+E3+E4);

N1=S./RN;
N2=lam.^2/2.*sin(lat).*cos(lat);
N3=lam.^4/24.*sin(lat).*cos(lat).^3.*(5-t.^2+9*h2+4*h2.^2);
N4=lam.^6/720.*sin(lat).*cos(lat).^5.*(61-58*t.^2+t.^4+ ...
   270*h2-330*t.^2.*h2+445*h2.^2+324*h2.^3-680*t.^2.*h2.^2+ ...
   88*h2.^4-600*t.^2.*h2.^3-192*t.^2.*h2.^4);
N5=lam.^8/40320.*sin(lat).*cos(lat).^7.*(1385-311*t.^2+543*t.^4-t.^6);
N=No+ko*RN.*(N1+N2+N3+N4+N5);


function m = meltpdd(dem,T,minalt,params)
% PURPOSE: calculate melt for a DEM based on a simple temperature index model
%          using positive degree days (PDD).
% -------------------------------------------------------------------
% USAGE: m = meltpdd(dem,T,minalt,params)
% where: [dem] is the input topography grid
%        [T] is the mean annual air temperature MAAT at sealevel in degC
%        [minalt] (optional) is the minimum altitude to calculate melt for
%                 (default min(dem(:)) )
%        [params] (optional) is a vector containing the 4 parameters:
%               ddf_ice: degree day factor for ice [m/d degC]
%               lrate:   temperature lapse rate in deg/100m
%               a_seas:  annual temp fluctuation in degrees.
%               tau_a:   length of the year in days to calculate annual fluctuation
%                        for, should be 365
%        [params] default to [8.0,0.6,5.0,365];
%        Values and model taken from
%        SJ Marshall and GKC Clarke 1999: Ice sheet inception: subgrid
%        hypsometric parameterisation of mass balance in an ice sheet
%        model. Climate Dynamics 15:533-550
%
%% -------------------------------------------------------------------------
% OUTPUTS:
%        m is an array with melt values for evey grid cell in dem above
%        minalt
% -------------------------------------------------------------------
% NOTE:  Seasonal variation is calculated using cos(2*pi*d/tau_a)
%        for d 1:tau_a.
%        Melt for areas lower than [minalt] is set to 0.
%
% EXAMPLE: m=meltpdd(randn(100,100)*1000,13,500,[8.0,0.6,5.0,365])
%
%% Felix Hebeler, Geography Dept., University Zurich, Jan 2007.

if nargin < 2
    error('This function needs 2 input parameters (DEM,T)');
end

% default parameter values
ddf_ice  = 8.0; % DDF f2or ice in m/d degC
%ddf_snow = 0.003;
lrate = 0.6;  % temperatur lapse rate in deg/100m
a_seas   = 5.0;   % annual amplitude of temperature fluctuations in degrees
tau_a    = 365;   %length of the year in days used in PDD

if ~exist('minalt','var')
    minalt=min(dem(:));
end

if ~exist('params','var')
    params=[ddf_ice,lrate,a_seas,tau_a];
end
params(1)=params(1)/1000;
% initialise
T = T - (dem*params(2)/100); % adjust T to be surface temperature for the DEM
%tempm=zeros(size(dem,1),size(dem,2)); % allocate matrix to hold daily melt
m = zeros(size(dem,1),size(dem,2)); % matrix for meltsum
% calc melt
for d=1:params(4)  % seasonal variation in melt
        % tempm = (T - (a_seas * cos(2*pi*d/tau_a)))*ddf_ice;
        tempm = (T - (params(3)*cos(2*pi*d/params(4))))*params(1);
        tempm(tempm<0)=0;
        m = m + tempm;
end
clear tempm;
m(dem<minalt)=0;
clear dem;


% Upsampling procedure.
%
% Argments:
%   'I': greyscale image
%   'odd': 2-vector of binary values, indicates whether the upsampled image
%   should have odd size for the respective dimensions
%   'filter': upsampling filter
%
% If image width W is odd, then the resulting image will have width (W-1)/2+1,
% Same for height.
%
% tom.mertens@gmail.com, August 2007
%

function R = upsample_(I,odd,filter)

% increase resolution
I = padarray(I,[1 1 0],'replicate'); % pad the image with a 1-pixel border
r = 2*size(I,1);
c = 2*size(I,2);
k = size(I,3);
R = zeros(r,c,k);
R(1:2:r, 1:2:c, :) = 4*I; % increase size 2 times; the padding is now 2 pixels wide

% interpolate, convolve with separable filter
R = imfilter(R,filter);     %horizontal
R = imfilter(R,filter');    %vertical

% remove the border
R = R(3:r - 2 - odd(1), 3:c - 2 - odd(2), :);


% Discrete All-Pole (DAP) envelope (AR model)
%
% Estimate an AR model based on given spectral peaks following the method in [1].
%
% Input
%  sins    : [Hz;amp] [2xN] Spectral peaks with frequency and linear amplitudes.
%            (as provided by sin_analysis.m)
%  fs      : [Hz] Sampling frequency
%  order   : Order of the AR model
% [dftlen] : DFT length of the envelope (if requested by the output)
% [opt]    : Additional options (see code below)
%
% Output
%  g  : gain factor
%  a  : AR coefficients
%  E  : Amplitude envelope (if dftlen is not empty)
%
% Reference
%  [1] El-Jaroudi, A., Makhoul, J.: Discrete All-Pole Modeling, IEEE Transactions
%      on Signal Processing 39(2), 411–423, 1991.
%
% Copyright (c) 2011 University of Crete - Computer Science Department
%
% License
%  This file is under the LGPL license,  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. This file 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.
%
% This function is part of the Covarep project: http://covarep.github.io/covarep
%
% Author
%  Gilles Degottex <degottex@csd.uoc.gr>
%

function [g a E opt] = env_dap(sins, fs, order, dftlen, opt)

    if nargin<5
        opt.maxit     = 50;     % Maximum number of iterations allowed
        opt.alpha     = 0.5;    % Convergence speed
        opt.dISthresh = 10e-7;  % Stopping threshold for Itakura-Saito err diff
        opt.minbw     = [];     % [Hz] Minimum bandwidth of the poles.
                                %    Slow down the computation significantly !
                                %    It should be at least zero in order to ensure
                                %    the stability of the AR filter.
                                %    Advised to set it to 50Hz

        opt.debug = 0;          % 1: show only final solution
                                % 2: show each step
    end
    if nargin==0; g=opt; return; end

    if ~isempty(opt.minbw); minrr=bandwidth2rootradius(opt.minbw, fs); end

    wm = 2*pi*sins(1,:)'/fs; % Radian frequencies
    P = abs(sins(2,:));      % Magnitues
    N = size(sins,2);        % Number of Peaks

    B = exp(-j*wm*double(0:order));  % The Fourier basis
    Binv = exp(j*wm*double(0:order));% The inverse Fourier basis

    if opt.debug>1
        subplot(211);
            hold off;
            plot(fs*wm/(2*pi), log(P), 'xk');
            hold on;
    end

    % Compute the target AR from the power-spectrum P^2, eq. (5) in [1]
    % Surely a mistake in [1] because the autocorr is the inv Fourier transform
    % of the POWER spectrum and not that of the magnitude.
    R = (1/N)*real(P.^2*Binv);
    Rmatinv = inv(toeplitz(R)); % Prepare the inverse of the AR matrix

    % Initial guess using the Levinson-Durbin recursion
    [a,e] = levinson(R,order);
    a = (1/sqrt(e))*a'; % Put the gain factor into the AR coefficients

    Phat = 1./abs(B*a); % Get the model amplitude response
    if opt.debug>1; subplot(211); plot(fs*wm/(2*pi), log(Phat), 'g'); end

    err = nan(1,opt.maxit);
    it=1;
    cont = true;
    while cont && it<opt.maxit
        if opt.debug>1
            subplot(211);
                plot(fs*wm/(2*pi), log(abs(Phat)));
                F = fs*(0:dftlen/2)/dftlen;
                E = gba2hspec(1, 1, a, dftlen);
                plot(F, log(abs(E)), 'r');
                xlim([0 fs/2]);
                xlabel('Frequency [Hz]');
                ylabel('Amplitude [log]');

            subplot(212);
                plot(log10(err));
                xlabel('Iterations');
                ylabel('Itakura-Saito error [log10]');
            pause
        end

        A = B*a; % Compute the frequency response of the model

        h = (1/N)*real(B.'*(1./A)); % Compute the reversed impulse response

        anew = a*(1-opt.alpha) + opt.alpha * (Rmatinv*h); % Update the AR coeffs

        % If asked, ensure stability of the AR filter
        % by limiting the bandwidth of the poles
        if ~isempty(opt.minbw); anew=polystab2(anew, minrr); end

        % Compute the Itakura-Saito error
        Phat = 1./abs(B*anew); % Get the model amplitude response
        err(it)  =  1/N *sum(P(:)./Phat-log(P(:)./Phat)-1); % eq. (14) in [1]

        if it>2 % Start at 3 in order to skip the influence of the initial guess
            cont = err(it-1)-err(it)>opt.dISthresh;
        end

        a = anew;

        it = it + 1;
    end

    % Put the gain back to a separate parameter in order to have a0=1
    g = 1./a(1);
    a = a./a(1);

    if nargout>2
        if isempty(dftlen); dftlen=4096; end
        E = gba2hspec(g, 1, a, dftlen);
    end

    if opt.debug==1
        hold off;
        plot(sins(1,:), log(sins(2,:)), 'xk');
        hold on;
        F = fs*(0:dftlen/2)/dftlen;
        E = gba2hspec(g, 1, a, dftlen);
        plot(F, log(abs(E)));
        xlim([0 fs/2]);
        keyboard
    end

return


%  Figure 7.13      Feedback Control of Dynamic Systems, 6e
%                        Franklin, Powell, Emami
%
% fig7_13.m is a script to generate Figure 7.13

% Impulse response
clf;
f=[0 1;-1 0];
g=[0;1];
h=[1 0];
K=[3 4];
fc=f-g*K;
gc=[4*g [1;0]];
hc=[h;[0 1]; -K/4];
jc=[0 0;0 0; 1 0];
sysCL=ss(fc,gc,hc,jc);
t=0:0.1:7;
y=impulse(sysCL,t);
plot(t,y(:,:,2));
xlabel('Time (sec)');
ylabel('Amplitude');
text(1.7,-.3,'x_2');
text(.5,.1,'u/4');
text(.7,.7,'x_1');
title('Fig. 7.13 Impulse response of the oscillator with full state feedback');
nicegrid;


% Creates a ZC sequence that is mapped onto an OFDM symbol and FFT'd
%
% The results of this function can be used to cross correlate for the specified OFDM
% symbol (numbers 4 or 6).  There is no cyclic prefix added by this function!
%
% 601 samples are created by the ZC, but the middle sample is zeroed out.  This is done
% so that the DC carrier of the FFT is not populated
%
% @param fft_size Size of the OFDM FFT window (must be power of 2)
% @param symbol_index Which ZC sequence symbol should be created (must be 4 or 6)
%
function [samples] = create_zc(fft_size, symbol_index)
    % Validate inputs
    assert(symbol_index == 4 || symbol_index == 6, "Invalid symbol index (must be 4 or 6)");
    assert(log2(fft_size) == round(log2(fft_size)), "Invalid FFT size.  Must be power of 2");

    % Pick the correct root for the ZC sequence
    if (symbol_index == 4)
        root = 600;
    else
        root = 147;
    end

    % Would use MATLAB's zadoffChuSeq function, but Octave doesn't have that
    % The logic below was tested against the MATLAB function
    zc = reshape(exp(-1j * pi * root * (0:600) .* (1:601) / 601), [], 1);

    % Remove the middle value (this would be DC in the FFT)
    zc(301) = [];

    % Create a buffer to hold the freq domain carriers
    samples_freq = zeros(fft_size, 1);

    % Get which FFT bins should be used for data carriers
    data_carrier_indices = get_data_carrier_indices(fft_size * 15e3);

    % Assign just the data carrier bins (left to right) the ZC sequence values
    samples_freq(data_carrier_indices) = zc;

    % Convert to time domain making sure to flip the spectrum left to right first
    samples = ifft(fftshift(samples_freq));
end


function F=FTaylor(deltaT,xCur,curT,a,dadx,d2adx,method)
%%FTAYLOR Simulate a nonlinear continuous-time random process specified by
%         the Langevin equation forward in time by a step-size of deltaT
%         using a Taylor scheme.
%
%INPUTS: deltaT The size of the single step over which to generate the
%               state transition matrix.
%          xCur The initial target state at time curT.
%          curT The time of the initial state xCur.
%             a The drift function in the continuous-time stochastic
%               dynamic model. It takes the state and a time variable as
%               its arguments, a(x,t).
%          dadx A xDimXxDim matrix of the derivative of the drift function
%               with respect to the state at state xCur and time curT.
%               This can also be a function that takes the state and a time
%               variable as its arguments, dadx(x,t).
%         d2adx A xDimXxDimXxDim matrix of the second derivative of the
%               drift function with respect to the state at state xCur and
%               time curT. The value at point (m,k,l) represents
%               d2a(m)/dx(k)dx(l). This can also be a function that takes
%               the state and a time variable as its arguments,
%               d2adx(x,t). If not provided, this is assumed to be zero.
%        method Set to 0 for the shorter Euler-Maruyama expansion,
%               otherwise will use Taylor expansion (default).
%
%OUTPUTS: F The state transition matrix under a nonlinear continuous-time
%           random process specified by the Langevin equation forward in
%           time by a step-size of deltaT using a strong Taylor scheme.
%
%The state prediction matrix is derived from the stochastic order 1.5
%Taylor scheme described in 10.4 of [1].
%
%REFERENCES:
%[1] P. E. Kloeden and E. Platen, Numerical Solution of Stochastic
%    Differential Equations. Berlin: Springer, 1999.
%
%April 2015 David Karnick, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

aCur=a(xCur,curT);
xDim=size(aCur,1);

if(nargin<6 || isempty(d2adx))
    d2adx=zeros(xDim,xDim,xDim);
end
if(nargin<7||isempty(method))
    method=1;
end
if(isa(dadx,'function_handle'))
    dadx=dadx(xCur,curT);
end
if(isa(d2adx,'function_handle'))
    d2adx=d2adx(xCur,curT);
end

if(method==0)
    F=eye(xDim)+deltaT*dadx;
else
    %assumes 3rd derivative is zero and all cross-derivatives are zero
    term1=zeros(xDim);
    for n=1:xDim
        term1(:,n)=d2adx(:,:,n)*aCur;
    end
    F=eye(xDim)+deltaT*dadx+(deltaT^2/2)*(term1+dadx*dadx);
end

%LICENSE:
%
%The source code is in the public domain and not licensed or under
%copyright. The information and software may be used freely by the public.
%As required by 17 U.S.C. 403, third parties producing copyrighted works
%consisting predominantly of the material produced by U.S. government
%agencies must provide notice with such work(s) identifying the U.S.
%Government material incorporated and stating that such material is not
%subject to copyright protection.
%
%Derived works shall not identify themselves in a manner that implies an
%endorsement by or an affiliation with the Naval Research Laboratory.
%
%RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF THE
%SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY THE NAVAL
%RESEARCH LABORATORY FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE ACTIONS
%OF RECIPIENT IN THE USE OF THE SOFTWARE.


function [radps] = GHz2radps(GHz)
% Convert frequency from gigahertz to radians per second.
% Chad A. Greene 2012
radps = GHz*(2*pi)*1e+9;


function [fx,dF_dX,dF_dTheta] = f_lin2D(Xt,Theta,ut,inF)
% dummy 2D linear evolution function

deltat = inF.deltat;

if ~ isfield (inF, 'a')
    inF.a = 1;
end
if ~ isfield (inF, 'b')
    inF.b = 1e-1;
end

inF.a = inF.a * exp (Theta(1));

A = [- inF.b, - inF.a;
     1, - inF.b];

fx = Xt + deltat * (A * Xt + ut);
dF_dX = eye (size (Xt, 1)) + deltat * A';

dF_dTheta = deltat * [- inF.a * Xt(2), 0];


function g = std( f, varargin )
%STD   Standard deviation of a SEPARABLEAPPROX along one variable.
%   G = STD(F) returns the standard deviation of F in the y-variable (default).
%   That is, if F is defined on the rectangle [a,b] x [c,d] then
%
%                         d
%                        /
%     std(F)^2 = 1/(d-c) | ( F(x,y) - mean(F,1) )^2 dy
%                        /
%                        c
%
%   G = STD(F, FLAG, DIM) takes the standard deviation along the y-variable if
%   DIM = 1 and along the x-variable if DIM = 2. The FLAG is ignored and kept in
%   this function so the syntax agrees with the Matlab STD command.
%
% See also CHEBFUN/STD, SEPARABLEAPPROX/MEAN.

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

% Empty check:
if ( isempty( f ) )
    g = chebfun();
    return
end

dom = f.domain;
if ( nargin < 3 )
    dim = 1;   % default to std over the y-variable.
elseif ( nargin == 3 )
    dim = varargin{ 2 };
else
    error( 'CHEBFUN:SEPARABLEAPPROX:std:nargin', 'Too many input arguments.' );
end

if ( dim == 1 )          % y-variable.
    mx = chebfun2(@(x,y) feval( mean(f, 1).', x), dom);
    g = sqrt(1/(diff(dom(3:4))) * sum((f - mx).^2, 1)).' ;
elseif ( dim == 2 )      %  x-variable.
    my = chebfun2(@(x,y) feval( mean(f, 2), y), dom);
    g = sqrt(1/(diff(dom(1:2))) * sum((f - my).^2, 2));
else
    error('CHEBFUN:SEPARABLEAPPROX:std:dim', ...
        'Third argument should have value 1 or 2.');
end

end


function net = gtminit(net, options, data, samp_type, varargin)
%GTMINIT Initialise the weights and latent sample in a GTM.
%
%	Description
%	NET = GTMINIT(NET, OPTIONS, DATA, SAMPTYPE) takes a GTM NET and
%	generates a sample of latent data points and sets the centres (and
%	widths if appropriate) of NET.RBFNET.
%
%	If the SAMPTYPE is 'REGULAR', then regular grids of latent data
%	points and RBF centres are created.  The dimension of the latent data
%	space must be 1 or 2.  For one-dimensional latent space, the
%	LSAMPSIZE parameter gives the number of latent points and the
%	RBFSAMPSIZE parameter gives the number of RBF centres.  For a two-
%	dimensional latent space, these parameters must be vectors of length
%	2 with the number of points in each of the x and y directions to
%	create a rectangular grid.  The widths of the RBF basis functions are
%	set by a call to RBFSETFW passing OPTIONS(7) as the scaling
%	parameter.
%
%	If the SAMPTYPE is 'UNIFORM' or 'GAUSSIAN' then the latent data is
%	found by sampling from a uniform or Gaussian distribution
%	correspondingly.  The RBF basis function parameters are set by a call
%	to RBFSETBF with the DATA parameter as dataset and the OPTIONS
%	vector.
%
%	Finally, the output layer weights of the RBF are initialised by
%	mapping the mean of the latent variable to the mean of the target
%	variable, and the L-dimensional latent variale variance to the
%	variance of the targets along the first L principal components.
%
%	See also
%	GTMINIT2, GTM, GTMEM, PCA, RBFSETBF, RBFSETFW
%

%	Copyright (c) Ian T Nabney (1996-2001)

% Check for consistency
errstring = consist(net, 'gtm', data);
if ~isempty(errstring)
  error(errstring);
end

% Check type of sample
stypes = {'regular', 'uniform', 'gaussian'};
if (strcmp(samp_type, stypes)) == 0
  error('Undefined sample type.')
end

if net.dim_latent > size(data, 2)
  error('Latent space dimension must not be greater than data dimension')
end
nlatent = net.gmmnet.ncentres;
nhidden = net.rbfnet.nhidden;

% Create latent data sample and set RBF centres

switch samp_type
case 'regular'
   if nargin ~= 6
      error('Regular type must specify latent and RBF shapes');
   end
   l_samp_size = varargin{1};
   rbf_samp_size = varargin{2};
   if round(l_samp_size) ~= l_samp_size
      error('Latent sample specification must contain integers')
   end
   % Check existence and size of rbf specification
   if any(size(rbf_samp_size) ~= [1 net.dim_latent]) | ...
         prod(rbf_samp_size) ~= nhidden
      error('Incorrect specification of RBF centres')
   end
   % Check dimension and type of latent data specification
   if any(size(l_samp_size) ~= [1 net.dim_latent]) | ...
         prod(l_samp_size) ~= nlatent
      error('Incorrect dimension of latent sample spec.')
   end
   if net.dim_latent == 1
      net.X = [-1:2/(l_samp_size-1):1]';
      net.rbfnet.c = [-1:2/(rbf_samp_size-1):1]';
      net.rbfnet = rbfsetfw(net.rbfnet, options(7));
   elseif net.dim_latent == 2
      net.X = gtm_rctg(l_samp_size);
      net.rbfnet.c = gtm_rctg(rbf_samp_size);
      net.rbfnet = rbfsetfw(net.rbfnet, options(7));
   else
      error('For regular sample, input dimension must be 1 or 2.')
   end

case {'uniform', 'gaussian'}
   if strcmp(samp_type, 'uniform')
      net.X = 2 * (rand(nlatent, net.dim_latent) - 0.5);
   else
      % Sample from N(0, 0.25) distribution to ensure most latent
      % data is inside square
      net.X = randn(nlatent, net.dim_latent)/2;
   end
   net.rbfnet = rbfsetbf(net.rbfnet, options, net.X);
otherwise
   % Shouldn't get here
   error('Invalid sample type');

end

% Latent data sample and basis function parameters chosen.
% Now set output weights
[PCcoeff, PCvec] = pca(data);

% Scale PCs by eigenvalues
A = PCvec(:, 1:net.dim_latent)*diag(sqrt(PCcoeff(1:net.dim_latent)));

[temp, Phi] = rbffwd(net.rbfnet, net.X);
% Normalise X to ensure 1:1 mapping of variances and calculate weights
% as solution of Phi*W = normX*A'
normX = (net.X - ones(size(net.X))*diag(mean(net.X)))*diag(1./std(net.X));
net.rbfnet.w2 = Phi \ (normX*A');
% Bias is mean of target data
net.rbfnet.b2 = mean(data);

% Must also set initial value of variance
% Find average distance between nearest centres
% Ensure that distance of centre to itself is excluded by setting diagonal
% entries to realmax
net.gmmnet.centres = rbffwd(net.rbfnet, net.X);
d = dist2(net.gmmnet.centres, net.gmmnet.centres) + ...
  diag(ones(net.gmmnet.ncentres, 1)*realmax);
sigma = mean(min(d))/2;

% Now set covariance to minimum of this and next largest eigenvalue
if net.dim_latent < size(data, 2)
  sigma = min(sigma, PCcoeff(net.dim_latent+1));
end
net.gmmnet.covars = sigma*ones(1, net.gmmnet.ncentres);

% Sub-function to create the sample data in 2d
function sample = gtm_rctg(samp_size)

xDim = samp_size(1);
yDim = samp_size(2);
% Produce a grid with the right number of rows and columns
[X, Y] = meshgrid([0:1:(xDim-1)], [(yDim-1):-1:0]);

% Change grid representation
sample = [X(:), Y(:)];

% Shift grid to correct position and scale it
maxXY= max(sample);
sample(:,1) = 2*(sample(:,1) - maxXY(1)/2)./maxXY(1);
sample(:,2) = 2*(sample(:,2) - maxXY(2)/2)./maxXY(2);
return;


function kern = gaussianwhiteKernParamInit(kern, isArd, nInd)

% GAUSSIANWHITEKERNPARAMINIT Gaussian white kernel parameter initialisation.
% The gaussian white kernel used here corresponds to the covariance of an
% output function which has been obtained like the output of the
% convolution operation between a smoothing kernel function T, which follows a
% a Gaussian form and white noise with variance s^2_r. It is given as
%
%    k(x_i, x_j) = s^2_r \int T_i(x_i - z)T_i(x_j - z) dz
%	             = s^2_r N(x_i;x_j, L_{i,r}^{-1} + L_{j,r}^{-1})
%
% where L_{i,r} corresponds to the inverse width in each direction of each
% pseudo point.
%
% FORMAT
% DESC  initialises the gaussian white kernel structure with some default
%       parameters.
% RETURN kern : the kernel structure with the default parameters placed in.
% ARG kern  : the kernel structure which requires initialisation.
% ARG isArd : specifies if the kernel is ARD
% ARG nInd  : number of inducing functions
%
% SEEALSO : kernCreate, kernParamInit
%
% COPYRIGHT : Mauricio A. Alvarez and Neil D. Lawrence, 2008
%
% MODIFICATIONS : Mauricio A. Alvarez, 2009.

% KERN

% By default it assumes the kernel is ARD and only have one inducing kernel
switch nargin
    case 1
        kern.isArd = false;
        kern.nIndFunct = 1;
    case 2
        kern.isArd = isArd;
        kern.nIndFunct = 1;
    case 3
        kern.isArd = isArd;
        kern.nIndFunct = nInd;
    otherwise
        error('Number of inputs is incorrect')
end

kern.sigma2Noise = 1;

if kern.isArd
    if kern.nIndFunct == 1
        kern.precisionT = ones(kern.inputDimension,1);
        kern.nParams = kern.inputDimension + 1;
    else
        kern.precisionT = ones(kern.inputDimension,kern.nIndFunct);
        kern.nParams = numel(kern.precisionT) + 1;
    end
else
    if kern.nIndFunct == 1
        kern.precisionT = 1;  % Number of rows should equal 1 if not ARD
        kern.nParams = 2;
    else
        kern.precisionT = ones(1,kern.nIndFunct);  % Number of rows should equal 1 if not ARD
        kern.nParams = kern.nIndFunct + 1;
    end
end
kern.transforms.index =1:kern.nParams;
kern.transforms.type = optimiDefaultConstraint('positive');
kern.isStationary = true;


function [V,mean_discrepancy]=mdp_eval_policy_TD_0(P,R,discount,policy,N)

% mdp_eval_policy_TD_0  Evaluation of the value function, using the TD(0) algorithm
%
% Arguments
% -------------------------------------------------------------------------
% Let S = number of states, A = number of actions
%   P(SxSxA)  = transition matrix
%              P could be an array with 3 dimensions or
%              a cell array (1xA), each cell containing a matrix (SxS) possibly sparse
%   R(SxSxA) or (SxA) = reward matrix
%              R could be an array with 3 dimensions (SxSxA) or
%              a cell array (1xA), each cell containing a sparse matrix (SxS) or
%              a 2D array(SxA) possibly sparse
%   discount  = discount rate in ]0; 1[
%   policy(S) = optimal policy
%   N(optional) = number of iterations to execute, default value: 10000.
%              It is an integer greater than the default value.
% Evaluation --------------------------------------------------------------
%   V(S)   = optimal value function.
%   mean_discrepancy(N/100) = vector of V discrepancy mean over 100 iterations
%             Then the length of this vector for the default value of N is 100.

% MDPtoolbox: Markov Decision Processes Toolbox
% Copyright (C) 2009  INRA
% Redistribution and use in source and binary forms, with or without modification,
% are permitted provided that the following conditions are met:
%    * Redistributions of source code must retain the above copyright notice,
%      this list of conditions and the following disclaimer.
%    * Redistributions in binary form must reproduce the above copyright notice,
%      this list of conditions and the following disclaimer in the documentation
%      and/or other materials provided with the distribution.
%    * Neither the name of the <ORGANIZATION> nor the names of its contributors
%      may be used to endorse or promote products derived from this software
%      without specific prior written permission.
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
% ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
% IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
% INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
% DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
% LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
% OF THE POSSIBILITY OF SUCH DAMAGE.

% Arguments checking
if iscell(P); S = size(P{1},1); else S = size(P,1); end;
if (nargin < 4 || nargin > 5)
    disp('------------------------------------------')
    disp('The number of arguments must be 4 or 5')
    disp('------------------------------------------')
elseif (discount <= 0 || discount >= 1)
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: Discount rate must be in ]0,1[')
    disp('--------------------------------------------------------')
elseif size(policy,1)~=S || any(mod(policy,1)) || any(policy<1) || any(policy>S)
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: policy must be a (1xS) vector with integer from 1 to S')
    disp('--------------------------------------------------------')
elseif (nargin == 5) && (N < 10000)
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: N must be upper than 10000')
    disp('--------------------------------------------------------')
else

    % initialization of optional argument
    if nargin < 5; N = 10000; end;

    % Initializations
    s=randi([1,S]);      % Initial state choice
    V=zeros(S,1);
    mean_discrepancy=[]; % vector of mean V variations
    discrepancy=[];      % vector of V variation

    for n=1:N

        % Reinitialisation of trajectories every 100 transitions
	if (mod(n,100)==0); s = randi([1,S]); end;

        % Select an action: here action of the policy
        a = policy(s);

        % Simulate next state s_new
        p_s_new = rand(1);
        p = 0;
        s_new = 0;
        while ((p <= p_s_new) && (s_new < S))
            s_new = s_new+1;
            if iscell(P)
                p = p+P{a}(s,s_new);
            else
                p = p+P(s,s_new,a);
            end
        end;

        % Update V
        if iscell(R)
            r = R{a}(s,s_new);
        else
            if ndims(R) == 3
                r = R(s,s_new,a);
            else
                r = R(s,a);
            end
        end
        delta = r + discount*V(s_new)-V(s);
        dV = (1/sqrt(n+2))*delta;
        V(s) = V(s)+dV;

        % Update current state
        s = s_new;

        % Memorize mean V variations on each trajectory (100 transitions)
        discrepancy(mod(n,100)+1) = abs(dV);
        if (length(discrepancy)==100)
            mean_discrepancy = [mean_discrepancy mean(discrepancy)];
            discrepancy = [];
        end;
    end;

end;


function [X_poly] = polyFeatures(X, p)
%POLYFEATURES Maps X (1D vector) into the p-th power
%   [X_poly] = POLYFEATURES(X, p) takes a data matrix X (size m x 1) and
%   maps each example into its polynomial features where
%   X_poly(i, :) = [X(i) X(i).^2 X(i).^3 ...  X(i).^p];
%

% You need to return the following variables correctly.
X_poly = zeros(numel(X), p);

% ====================== YOUR CODE HERE ======================
% Instructions: Given a vector X, return a matrix X_poly where the p-th
%               column of X contains the values of X to the p-th power.
%
%

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

end


function F = curl(F)
%CURL  curl of a CHEBFUN2V
%   S = CURL(F) returns the CHEBFUN2 of the curl of F. If F is a CHEBFUN2V with
%   two components then it returns the CHEBFUN2 representing
%         CURL(F) = F(2)_x - F(1)_y,
%   where F = (F(1),F(2)).  If F is a CHEBFUN2V with three components then it
%   returns the CHEBFUN2V representing the 3D curl operation.

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

% Empty check:
if ( isempty( F ) )
    F = chebfun2v;
    return
end

Fc = F.components;

if ( F.nComponents == 2 )  % 2D curl
    F = diff(Fc{2}, 1, 2) - diff(Fc{1}, 1, 1);
else                       % 3D curl
    F = [ diff(Fc{3},1,1) ; -diff(Fc{3},1,2) ;...
          diff(Fc{2},1,2) - diff(Fc{1},1,1) ];
end

end


%%%%%script to generate figure 1 of Invariant Scattering Convolution Networks
%%%%%feb 2012%%%%%%%
%%%%%%Joan Bruna and Stephane Mallat$$$$$$$$$

%%%%%This figure shows the Morlet Wavelet used throughout the numerical
%%%%%experiments of the paper%%%%%%%%

N=256;
%options.wavelet_family='morlet';
%options=configure_wavelet_options(options);
%filters=options.filter_bank_name([N N], options);
foptions.J=2;
foptions.L=6;
soptions.M=2;
[Wop,filters]=wavelet_factory_2d([N N], foptions, soptions);

R=8;

Nc=55;

figure
imagesc(flipud(crop(real(fftshift(ifft2(filters.psi.filter{R}.coefft{1}))),Nc,N/2)))
colormap gray
axis square
set(gca,'YTick',[])
set(gca,'XTick',[])

figure
imagesc(flipud(crop(imag(fftshift(ifft2(filters.psi.filter{R}.coefft{1}))),Nc,N/2)))
colormap gray
axis square
set(gca,'YTick',[])
set(gca,'XTick',[])

figure
imagesc(add_circular_mask(flipud(abs(fftshift(filters.psi.filter{R}.coefft{1}))),0.98,1))
%imagesc((flipud(abs(fftshift(filters.psi{1}{2}{2})))))
cc=colormap(gray);
colormap(1-cc)
axis square
axis off
set(gca,'YTick',[])
set(gca,'XTick',[])


function v = kspace3d(v,M)
% 3D rigid body transformation performed as shears in 1D Fourier space.
% FORMAT v1 = kspace3d(v,M)
% Inputs:
% v - the image stored as a 3D array.
% M - the rigid body transformation matrix.
% Output:
% v - the transformed image.
%
% The routine is based on the excellent papers:
% R. W. Cox and A. Jesmanowicz (1999)
% Real-Time 3D Image Registration for Functional MRI
% Submitted to MRM (April 1999) and avaliable from:
% http://varda.biophysics.mcw.edu/~cox/index.html.
% and:
% W. F. Eddy, M. Fitzgerald and D. C. Noll (1996)
% Improved Image Registration by Using Fourier Interpolation
% Magnetic Resonance in Medicine 36(6):923-931
%_______________________________________________________________________

% taken from SPM8

[S0,S1,S2,S3] = shear_decomp(M);

d  = [size(v) 1 1 1];
g = 2.^ceil(log2(d));
if any(g~=d),
    tmp = v;
    v   = zeros(g);
    v(1:d(1),1:d(2),1:d(3)) = tmp;
    clear tmp;
end

% XY-shear
tmp1 = -sqrt(-1)*2*pi*([0:((g(3)-1)/2) 0 (-g(3)/2+1):-1])/g(3);
for j=1:g(2),
    t        = reshape( exp((j*S3(3,2) + S3(3,1)*(1:g(1)) + S3(3,4)).'*tmp1) ,[g(1) 1 g(3)]);
    v(:,j,:) = real(ifft(fft(v(:,j,:),[],3).*t,[],3));
end

% XZ-shear
tmp1 = -sqrt(-1)*2*pi*([0:((g(2)-1)/2) 0 (-g(2)/2+1):-1])/g(2);
for k=1:g(3),
    t        = exp( (k*S2(2,3) + S2(2,1)*(1:g(1)) + S2(2,4)).'*tmp1);
    v(:,:,k) = real(ifft(fft(v(:,:,k),[],2).*t,[],2));
end

% YZ-shear
tmp1 = -sqrt(-1)*2*pi*([0:((g(1)-1)/2) 0 (-g(1)/2+1):-1])/g(1);
for k=1:g(3),
    t        = exp( tmp1.'*(k*S1(1,3) + S1(1,2)*(1:g(2)) + S1(1,4)));
    v(:,:,k) = real(ifft(fft(v(:,:,k),[],1).*t,[],1));
end

% XY-shear
tmp1 = -sqrt(-1)*2*pi*([0:((g(3)-1)/2) 0 (-g(3)/2+1):-1])/g(3);
for j=1:g(2),
    t        = reshape( exp( (j*S0(3,2) + S0(3,1)*(1:g(1)) + S0(3,4)).'*tmp1) ,[g(1) 1 g(3)]);
    v(:,j,:) = real(ifft(fft(v(:,j,:),[],3).*t,[],3));
end

if any(g~=d), v = v(1:d(1),1:d(2),1:d(3)); end
return;
%_______________________________________________________________________

%_______________________________________________________________________


function pdf = circdensity(bc, bp, sig,varargin)
% Wrapped gaussian fit for circular, axial data in the range 0:pi
% Input:
%    bc  -  list of angles (= bincenters)
%    bp  -  list of values (= Bin population)
%    sig -  sigma of Gaussian used to smooth the distribution
%
% Options:
%    sum -  do not normalize to area = 1 (default) but sum of radii =1
%
% Output:
%    pdf - circular density function

% Todo: make it work for other functions as well
bc=reshape(bc,[],1);
bp=reshape(bp,[],1);
% check input
if bc(1)==bc(end)
    bc(end)=[];
    bp(end)=[];
    circflag = 1;
end

% make Gaussian kernel
G = (exp( -((bc - pi).^2)./ (2*(sig)^2) ));
% convolve kernel with data
pdf = ifft(fft(bp).*fft(G));
% normalize values
if check_option(varargin,'sum')
% to area. Is that useful?
pdf = pdf./sum(pdf);
else
pdf = pdf./sqrt(polyarea(cos(bc).*pdf,sin(bc).*pdf));
end

if circflag==1
 pdf(end+1) = pdf(1);
end

end


function pass = test_sum2( )
% Test spherefun sum2() command.

tol = 1000*chebfunpref().cheb2Prefs.chebfun2eps;

f = @(x,y,z) 1 + x + y + z;
g = spherefun(f);
exact_int = 4*pi;
pass(1) = abs(sum2(g) - exact_int) < tol;

f = @(x,y,z) 0.75*exp(-(9*x-2).^2/4 - (9*y-2).^2/4 - (9*z-2).^2/4)...
   + 0.75*exp(-(9*x+1).^2/49 - (9*y+1)/10 - (9*z+1)/10)...
   + 0.5*exp(-(9*x-7).^2/4 - (9*y-3).^2/4 - (9*z-5).^2/4)...
   - 0.2*exp(-(9*x-4).^2 - (9*y-7).^2 - (9*z-5).^2);
exact_int = 6.6961822200736179523;
g = spherefun(f);
pass(2) = abs(sum2(g) - exact_int) < tol;

end


function [ x, w ] = jacobi_ss_compute ( n, alpha, beta )

%*****************************************************************************80
%
%% JACOBI_SS_COMPUTE computes the abscissa and weights for Gauss-Jacobi quadrature.
%
%  Discussion:
%
%    The integral:
%
%      Integral ( -1 <= X <= 1 ) (1-X)**ALPHA * (1+X)**BETA * F(X) dX
%
%    The quadrature rule:
%
%      Sum ( 1 <= I <= N ) W(I) * F ( X(I) )
%
%    Thanks to Xu Xiang of Fudan University for pointing out that
%    an earlier implementation of this routine was incorrect!
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 October 2011
%
%  Author:
%
%    Original FORTRAN77 version by Arthur Stroud, Don Secrest.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Arthur Stroud, Don Secrest,
%    Gaussian Quadrature Formulas,
%    Prentice Hall, 1966,
%    LC: QA299.4G3S7.
%
%  Parameters:
%
%    Input, integer N, the order.
%
%    Input, real ALPHA, BETA, the exponents of (1-X) and
%    (1+X) in the quadrature rule.  For simple Gauss-Legendre quadrature,
%    set ALPHA = BETA = 0.0.  -1.0 < ALPHA and -1.0 < BETA are required.
%
%    Output, real X(N), the abscissas.
%
%    Output, real W(N), the weights.
%

%
%  Check ALPHA and BETA.
%
  if ( alpha <= -1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'JACOBI_SS_COMPUTE - Fatal error!\n' );
    fprintf ( 1, '  -1.0 < ALPHA is required.\n' );
    error ( 'JACOBI_SS_COMPUTE - Fatal error!' );
  end

  if ( beta <= -1.0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'JACOBI_SS_COMPUTE - Fatal error!\n' );
    fprintf ( 1, '  -1.0 < BETA is required.\n' );
    error ( 'JACOBI_SS_COMPUTE - Fatal error!' );
  end

  x = zeros ( n, 1 );
  w = zeros ( n, 1 );
  b = zeros ( n, 1 );
  c = zeros ( n, 1 );
%
%  Set the recursion coefficients.
%
  for i = 1 : n

    if ( alpha + beta == 0.0 || beta - alpha == 0.0 )

      b(i) = 0.0;

    else

      b(i) = ( alpha + beta ) * ( beta - alpha ) / ...
            ( ( alpha + beta + 2 * i ) ...
            * ( alpha + beta + 2 * i - 2 ) );

    end

    if ( i == 1 )

      c(i) = 0.0;

    else

      c(i) = 4.0 * ( i - 1 ) * ( alpha + i - 1 ) * ( beta + i - 1 ) ...
        * ( alpha + beta + i - 1 ) / ( ( alpha + beta + 2 * i - 1 ) ...
        * ( alpha + beta + 2 * i - 2 )^2 * ( alpha + beta + 2 * i - 3 ) );

    end

  end

  delta = exp ( gammaln ( alpha        + 1.0 ) ...
              + gammaln (         beta + 1.0 ) ...
              - gammaln ( alpha + beta + 2.0 ) );

  cc = delta * 2.0^( alpha + beta + 1.0 ) * prod ( c(2:n) );

  for i = 1 : n

    if ( i == 1 )

      an = alpha / n;
      bn = beta / n;

      r1 = ( 1.0 + alpha ) * ( 2.78 / ( 4.0 + n * n ) ...
        + 0.768 * an / n );

      r2 = 1.0 + 1.48 * an + 0.96 * bn + 0.452 * an^2 + 0.83 * an * bn;

      xval = ( r2 - r1 ) / r2;

    elseif ( i == 2 )

      r1 = ( 4.1 + alpha ) / ...
        ( ( 1.0 + alpha ) * ( 1.0 + 0.156 * alpha ) );

      r2 = 1.0 + 0.06 * ( n - 8.0 ) * ( 1.0 + 0.12 * alpha ) / n;

      r3 = 1.0 + 0.012 * beta * ...
        ( 1.0 + 0.25 * abs ( alpha ) ) / n;

      xval = xval - r1 * r2 * r3 * ( 1.0 - xval );

    elseif ( i == 3 )

      r1 = ( 1.67 + 0.28 * alpha ) / ( 1.0 + 0.37 * alpha );

      r2 = 1.0 + 0.22 * ( n - 8.0 ) / n;

      r3 = 1.0 + 8.0 * beta / ( ( 6.28 + beta ) * n * n );

      xval = xval - r1 * r2 * r3 * ( x(1) - xval );

    elseif ( i < n - 1 )

      xval = 3.0 * x(i-1) - 3.0 * x(i-2) + x(i-3);

    elseif ( i == n - 1 )

      r1 = ( 1.0 + 0.235 * beta ) / ( 0.766 + 0.119 * beta );

      r2 = 1.0 / ( 1.0 + 0.639 * ( n - 4.0 ) ...
        / ( 1.0 + 0.71 * ( n - 4.0 ) ) );

      r3 = 1.0 / ( 1.0 + 20.0 * alpha / ( ( 7.5 + alpha ) * n * n ) );

      xval = xval + r1 * r2 * r3 * ( xval - x(i-2) );

    elseif ( i == n )

      r1 = ( 1.0 + 0.37 * beta ) / ( 1.67 + 0.28 * beta );

      r2 = 1.0 / ( 1.0 + 0.22 * ( n - 8.0 ) / n );

      r3 = 1.0 / ( 1.0 + 8.0 * alpha / ( ( 6.28 + alpha ) * n * n ) );

      xval = xval + r1 * r2 * r3 * ( xval - x(i-2) );

    end

    [ xval, dp2, p1 ] = jacobi_ss_root ( xval, n, alpha, beta, b, c );

    x(i) = xval;
    w(i) = cc / ( dp2 * p1 );

  end
%
%  Reverse the order of the values.
%
  x = r8vec_reverse ( n, x );
  w = r8vec_reverse ( n, w );

  return
end


function out = ICC(cse,typ,dat)
% Function to work out ICCs according to shrout & fleiss' schema (Shrout PE,
% Fleiss JL. Intraclass correlations: uses in assessing rater reliability.
% Psychol Bull. 1979;86:420-428).
%
% :Usage:
% ::
%
%     iccvalue = ICC([1 to 6],['single' or 'k'], data matrix)
%
% :Inputs:
%
%   **'dat':**
%        is data whose *columns* represent k different raters (judges) & whose
%        *rows* represent n different cases or targets being measured. Each target
%        is assumed to be a random sample from a population of targets.
%
%   **'cse':**
%        is either 1,2,3. 'cse' is: 1 if each target is measured by a
%        different set of raters from a population of raters, 2 if each target is
%        measured by the same raters, but that these raters are sampled from a
%        population of raters, 3 if each target is measured by the same raters and
%        these raters are the only raters of interest.
%
%   **'typ':**
%        is either 'single' or 'k' & denotes whether the ICC is based on a
%        single measurement or on an average of k measurements, where k = the
%        number of ratings/raters.
%
% This has been tested using the example data in the paper by shrout & fleiss.
%
% Example: out = ICC(3,'k',S_Fdata)
% returns ICC(3,k) of data 'S_Fdata' to double 'out'.
%
% Kevin Brownhill, Imaging Sciences, KCL, London kevin.brownhill@kcl.ac.uk
%
% :Additional documentation:
%
% iccvalue = ICC([1 to 6],['single' or 'k'], data matrix)
%
% Here, columns are 'judges', or more generally, 'measures' that are
% usually ideally intercorrelated.  Rows are items being assessed.
% The ICC assesses the proportion of variance attributed to the items,
%  shared across measures.
% As the correlation between the measures grows, the icc grows.
% Another way of saying this is that if the rows are consistently different
% across measures, the icc will be high.
%
% Think of rows as criminals, and columns as judges. The data values are 'guilt scores',
% where higher is more guilty.  If all the judges agree, the most guilty
% cases will be rated as most guilty by all judges, and the icc will be
% high. This is actually consistent with Case 2 or 3 in Shrout and Fleiss.
%
% In Case 1, the columns don't have any real meaning, as there are
% different 'judges' for each row, and variance components due to judge
% cannot be separated from error and the judge x target interaction.
% In Case 2 and 3, they are crossed. Case 2 treats judge as a random
% effect, whereas Case 3 treats judge as a fixed effect.
%
% If the data were an individual differences study of cognitive performance,
% then the rows would be subjects, and the columns would be tests.
% A high icc would indicate a high correlation across the tests, which
% indicates that subjects are reliably different from one another, i.e.,
% that a large proportion of the total variance is related to subject.
% In such a case, as tests are fixed entities, then Case 3 might be
% appropriate.
%
% Cronbach's alpha is equal to ICC(3, k) - case 3, k
% This assumes no target x rater interaction
%
% :Examples:
% ::
%
%    dat = mvnrnd([1 1 1], [1 .5 .5; .5 1 .5; .5 .5 1], 50); whos dat
%    corrcoef(dat)
%    ri = ICC(2, 'k', dat)
%    dat = mvnrnd([1 1 1], [1 .9 .9; .9 1 .9; .9 .9 1], 50); whos dat
%    corrcoef(dat)
%    ri = ICC(2, 'k', dat)
%
% In the example below, judges (measures) have systematically different
% means, and the ICC values are different.  ICC(1, 1) is low because judge
% is not considered as a source of variance.  ICC(2, 1) is higher, but
% intermediate, because judge is considered as a random effect and modeled,
% but we want to generalize to new judges.  ICC(3, 1) is highest, because
% judge is modeled
%    dat = mvnrnd([1 2 3], [1 .5 .5; .5 1 .5; .5 .5 1], 50); whos dat
%    ri = ICC(1, 'single', dat)
%    ri = ICC(2, 'single', dat)
%    ri = ICC(3, 'single', dat)
%
% ..
%    Modified 10/09 by Tor Wager; minor bug fix and changes to documentation
% ..

%number of raters/ratings
k = size(dat,2);
%number of targets
n = size(dat,1);
%mean per target
mpt = mean(dat,2);
%mean per rater/rating
mpr = mean(dat);
%get total mean
tm = mean(mpt);
%within target sum sqrs
WSS = sum(sum(bsxfun(@minus,dat,mpt).^2));
%within target mean sqrs
WMS = WSS / (n * (k - 1));
%between rater sum sqrs
RSS = sum((mpr - tm).^2) * n;
%between rater mean sqrs
RMS = RSS / (k - 1);
% %get total sum sqrs
% TSS = sum(sum((dat - tm).^2));
%between target sum sqrs
BSS = sum((mpt - tm).^2) * k;
%between targets mean squares
BMS = BSS / (n - 1);
%residual sum of squares
ESS = WSS - RSS;
%residual mean sqrs
EMS = ESS / ((k - 1) * (n - 1));
switch cse
    case 1
        switch typ
            case 'single'
                out = (BMS - WMS) / (BMS + (k - 1) * WMS);
            case 'k'
                out = (BMS - WMS) / BMS;
            otherwise
               error('Wrong value for input typ')
        end
    case 2
        switch typ
            case 'single'
                out = (BMS - EMS) / (BMS + (k - 1) * EMS + k * (RMS - EMS) / n);
            case 'k'
                out = (BMS - EMS) / (BMS + (RMS - EMS) / n);
            otherwise
               error('Wrong value for input typ')
        end
    case 3
        switch typ
            case 'single'
                out = (BMS - EMS) / (BMS + (k - 1) * EMS);
            case 'k'
                out = (BMS - EMS) / BMS;
            otherwise
               error('Wrong value for input typ')
        end
    otherwise
        error('Wrong value for input cse')
end


function pass = test_coeffs2diskfun( )
% test diskfun coeff2diskfun() command

tol = 10*chebfunpref().cheb2Prefs.chebfun2eps;

f = diskfun.coeffs2diskfun(0);
pass(1) = iszero(f);

f = diskfun(@(t,r) r.^2, 'polar');
g = diskfun.coeffs2diskfun(coeffs2(f));
pass(2) = norm(f-g) < tol;

f = diskfun(@(t,r) r.*sin(t), 'polar');
g = diskfun.coeffs2diskfun(coeffs2(f));
pass(3) = norm(f-g) < tol;

f = diskfun(@(x,y) exp(-10*((x-0.5/sqrt(2)).^2 + (y-0.5/sqrt(2)).^2)));
g = diskfun.coeffs2diskfun(coeffs2(f));
pass(4) = norm(f-g);

f = diskfun(@(t,r) r.*sin(t), 'polar');
c = 1i/(2)*[0 0 0 ; 1 0 -1 ];
pass(5) = norm( f - diskfun.coeffs2diskfun(c) ) < tol;

f = diskfun(@(t,r) r.^3.*cos(3*t)+r.^2.*(sin(t)).^2, 'polar');
c = (1/8)*[0 -1 0 2 0 -1 0; 3 0 0 0 0 0 3; 0 -1 0 2 0 -1 0;1 0 0 0 0 0 1];
pass(6) = norm( f - diskfun.coeffs2diskfun(c) ) < tol;

end


%% Machine Learning Online Class
%  Exercise 5 | Regularized Linear Regression and Bias-Variance
%
%  Instructions
%  ------------
%
%  This file contains code that helps you get started on the
%  exercise. You will need to complete the following functions:
%
%     linearRegCostFunction.m
%     learningCurve.m
%     validationCurve.m
%
%  For this exercise, you will not need to change any code in this file,
%  or any other files other than those mentioned above.
%

%% Initialization
clear ; close all; clc

%% =========== Part 1: Loading and Visualizing Data =============
%  We start the exercise by first loading and visualizing the dataset.
%  The following code will load the dataset into your environment and plot
%  the data.
%

% Load Training Data
fprintf('Loading and Visualizing Data ...\n')

% Load from ex5data1:
% You will have X, y, Xval, yval, Xtest, ytest in your environment
load ('ex5data1.mat');

% m = Number of examples
m = size(X, 1);

% Plot training data
plot(X, y, 'rx', 'MarkerSize', 10, 'LineWidth', 1.5);
xlabel('Change in water level (x)');
ylabel('Water flowing out of the dam (y)');

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 2: Regularized Linear Regression Cost =============
%  You should now implement the cost function for regularized linear
%  regression.
%

theta = [1 ; 1];
J = linearRegCostFunction([ones(m, 1) X], y, theta, 1);

fprintf(['Cost at theta = [1 ; 1]: %f '...
         '\n(this value should be about 303.993192)\n'], J);

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 3: Regularized Linear Regression Gradient =============
%  You should now implement the gradient for regularized linear
%  regression.
%

theta = [1 ; 1];
[J, grad] = linearRegCostFunction([ones(m, 1) X], y, theta, 1);

fprintf(['Gradient at theta = [1 ; 1]:  [%f; %f] '...
         '\n(this value should be about [-15.303016; 598.250744])\n'], ...
         grad(1), grad(2));

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 4: Train Linear Regression =============
%  Once you have implemented the cost and gradient correctly, the
%  trainLinearReg function will use your cost function to train
%  regularized linear regression.
%
%  Write Up Note: The data is non-linear, so this will not give a great
%                 fit.
%

%  Train linear regression with lambda = 0
lambda = 1;
[theta] = trainLinearReg([ones(m, 1) X], y, lambda);

%  Plot fit over the data
plot(X, y, 'rx', 'MarkerSize', 10, 'LineWidth', 1.5);
xlabel('Change in water level (x)');
ylabel('Water flowing out of the dam (y)');
hold on;
plot(X, [ones(m, 1) X]*theta, '--', 'LineWidth', 2)
hold off;

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 5: Learning Curve for Linear Regression =============
%  Next, you should implement the learningCurve function.
%
%  Write Up Note: Since the model is underfitting the data, we expect to
%                 see a graph with "high bias" -- slide 8 in ML-advice.pdf
%

lambda = 1;
[error_train, error_val] = ...
    learningCurve([ones(m, 1) X], y, ...
                  [ones(size(Xval, 1), 1) Xval], yval, ...
                  lambda);

plot(1:m, error_train, 1:m, error_val);
title('Learning curve for linear regression')
legend('Train', 'Cross Validation')
xlabel('Number of training examples')
ylabel('Error')
axis([0 13 0 150])

fprintf('# Training Examples\tTrain Error\tCross Validation Error\n');
for i = 1:m
    fprintf('  \t%d\t\t%f\t%f\n', i, error_train(i), error_val(i));
end

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 6: Feature Mapping for Polynomial Regression =============
%  One solution to this is to use polynomial regression. You should now
%  complete polyFeatures to map each example into its powers
%

p = 8;

% Map X onto Polynomial Features and Normalize
X_poly = polyFeatures(X, p);
[X_poly, mu, sigma] = featureNormalize(X_poly);  % Normalize
X_poly = [ones(m, 1), X_poly];                   % Add Ones

% Map X_poly_test and normalize (using mu and sigma)
X_poly_test = polyFeatures(Xtest, p);
X_poly_test = bsxfun(@minus, X_poly_test, mu);
X_poly_test = bsxfun(@rdivide, X_poly_test, sigma);
X_poly_test = [ones(size(X_poly_test, 1), 1), X_poly_test];         % Add Ones

% Map X_poly_val and normalize (using mu and sigma)
X_poly_val = polyFeatures(Xval, p);
X_poly_val = bsxfun(@minus, X_poly_val, mu);
X_poly_val = bsxfun(@rdivide, X_poly_val, sigma);
X_poly_val = [ones(size(X_poly_val, 1), 1), X_poly_val];           % Add Ones

fprintf('Normalized Training Example 1:\n');
fprintf('  %f  \n', X_poly(1, :));

fprintf('\nProgram paused. Press enter to continue.\n');
pause;

%% =========== Part 7: Learning Curve for Polynomial Regression =============
%  Now, you will get to experiment with polynomial regression with multiple
%  values of lambda. The code below runs polynomial regression with
%  lambda = 0. You should try running the code with different values of
%  lambda to see how the fit and learning curve change.
%

lambda = 1;
[theta] = trainLinearReg(X_poly, y, lambda);

% Plot training data and fit
figure(1);
plot(X, y, 'rx', 'MarkerSize', 10, 'LineWidth', 1.5);
plotFit(min(X), max(X), mu, sigma, theta, p);
xlabel('Change in water level (x)');
ylabel('Water flowing out of the dam (y)');
title (sprintf('Polynomial Regression Fit (lambda = %f)', lambda));

figure(2);
[error_train, error_val] = ...
    learningCurve(X_poly, y, X_poly_val, yval, lambda);
plot(1:m, error_train, 1:m, error_val);

title(sprintf('Polynomial Regression Learning Curve (lambda = %f)', lambda));
xlabel('Number of training examples')
ylabel('Error')
axis([0 13 0 100])
legend('Train', 'Cross Validation')

fprintf('Polynomial Regression (lambda = %f)\n\n', lambda);
fprintf('# Training Examples\tTrain Error\tCross Validation Error\n');
for i = 1:m
    fprintf('  \t%d\t\t%f\t%f\n', i, error_train(i), error_val(i));
end

fprintf('Program paused. Press enter to continue.\n');
pause;

%% =========== Part 8: Validation for Selecting Lambda =============
%  You will now implement validationCurve to test various values of
%  lambda on a validation set. You will then use this to select the
%  "best" lambda value.
%

[lambda_vec, error_train, error_val] = ...
    validationCurve(X_poly, y, X_poly_val, yval);

close all;
plot(lambda_vec, error_train, lambda_vec, error_val);
legend('Train', 'Cross Validation');
xlabel('lambda');
ylabel('Error');

fprintf('lambda\t\tTrain Error\tValidation Error\n');
for i = 1:length(lambda_vec)
	fprintf(' %f\t%f\t%f\n', ...
            lambda_vec(i), error_train(i), error_val(i));
end

fprintf('Program paused. Press enter to continue.\n');
pause;


function cot_values_test ( )

%*****************************************************************************80
%
%% COT_VALUES_TEST demonstrates the use of COT_VALUES.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 January 2015
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'COT_VALUES_TEST:\n' );
  fprintf ( 1, '  COT_VALUES stores values of \n' );
  fprintf ( 1, '  the cotangent function.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '      X           FX\n' );
  fprintf ( 1, '\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, x, fx ] = cot_values ( n_data );

    if ( n_data == 0 )
      break
    end

    fprintf ( 1, '  %12f  %24.16f\n', x, fx );

  end

  return
end


function prob_test133 ( )

%*****************************************************************************80
%
%% TEST133 tests RECIPROCAL_CDF, RECIPROCAL_CDF_INV, RECIPROCAL_CDF;
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST133\n' );
  fprintf ( 1, '  For the Reciprocal PDF:\n' );
  fprintf ( 1, '  RECIPROCAL_CDF evaluates the CDF.\n' );
  fprintf ( 1, '  RECIPROCAL_CDF_INV inverts the CDF.\n' );
  fprintf ( 1, '  RECIPROCAL_PDF evaluates the PDF.\n' );

  a = 1.0;
  b = 3.0;

  check = reciprocal_check ( a, b );

  if ( ~check );
    fprintf ( 1, '\n' );
    fprintf ( 1, 'TEST133 - Fatal error!\n' );
    fprintf ( 1, '  The parameters are not legal.\n' );
    return
  end

  fprintf ( 1, '\n' );
  fprintf ( 1, '  PDF parameter A =         %14f\n', a );
  fprintf ( 1, '  PDF parameter B =         %14f\n', b );

  seed = 123456789;

  fprintf ( 1, '\n' );
  fprintf ( 1, '       X            PDF           CDF            CDF_INV\n' );
  fprintf ( 1, '\n' );

  for i = 1 : 10

    [ x, seed ] = reciprocal_sample ( a, b, seed );

    pdf = reciprocal_pdf ( x, a, b );

    cdf = reciprocal_cdf ( x, a, b );

    x2 = reciprocal_cdf_inv ( cdf, a, b );

    fprintf ( 1, ' %14f  %14f  %14f  %14f\n', x, pdf, cdf, x2 );

  end

  return
end


function h = entropy(vec1)
%=========================================================
%
%This is a prog in the MutualInfo 0.9 package written by
% Hanchuan Peng.
%
%Disclaimer: The author of program is Hanchuan Peng
%      at <penghanchuan@yahoo.com> and <phc@cbmv.jhu.edu>.
%
%The CopyRight is reserved by the author.
%
%Last modification: April/19/2002
%
%========================================================
%
% h = entropy(vec1)
% calculate the entropy of a variable vec1
%
% demo:
%  a=[1 2 1 2 1]';b=[2 1 2 1 1]';
%  fprintf('entropy(a) = %d\n',entropy(a));
%
% the same as entropycond(vec1)
%
% By Hanchuan Peng, April/2002
%

if nargin<1,

  disp('Usage: h = entropy(vec1).');
  h = -1;

else,

  [p1] = estpa(vec1);
  h = estentropy(p1);

end;


function value = p25_exact ( dim_num )

%*****************************************************************************80
%
%% P25_EXACT returns the exact integral for problem 25.
%
%  Discussion:
%
%    The formula in the reference seems to yield a result
%    that is too small by 1.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 March 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Output, real VALUE, the exact value of the integral.
%
  c = 0.0;
  c = p25_r8 ( 'G', 'C', c );

  roundoff = eps;

  value = 1.0;

  term = 1.0;
  i = 0;

  while ( 1 )

    i = i + 1;
    term = term * c / i;

    term2 = term / ( i + 1 )^dim_num;

    if ( abs ( term2 ) <= roundoff * ( 1.0 + abs ( value ) ) )
      break
    end

    value = value + term2;

  end

  return
end


function coef=spreadfun(T)
%SPREADFUN  Spreading function of a matrix
%   Usage:  c=spreadfun(T);
%
%   `spreadfun(T)` computes the spreading function of the operator *T*,
%   represented as a matrix. The spreading function represent the operator *T*
%   as a weighted sum of time-frequency shifts. See the help text for
%   |spreadop| for the exact definition.
%
%   See also:  spreadop, tconv, spreadinv, spreadadj

complainif_argnonotinrange(nargin,1,1,mfilename);

if ndims(T)>2 || size(T,1)~=size(T,2)
    error('Input symbol T must be a square matrix.');
end;

L=size(T,1);

% The 'full' appearing on the next line is to guard the mex file.
coef=comp_col2diag(full(T));

coef=fft(coef)/L;


function trace = r8mat_trace ( n, a )

%*****************************************************************************80
%
%% R8MAT_TRACE computes the trace of an R8MAT.
%
%  Discussion:
%
%    The trace of a square matrix is the sum of the diagonal elements.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    23 April 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the order of the matrix A.
%
%    Input, real A(N,N), the matrix whose trace is desired.
%
%    Output, real TRACE, the trace of the matrix.
%
  trace = 0.0;
  for i = 1 : n
    trace = trace + a(i,i);
  end

  return
end