function [movie_frame] = show_s2_partition(N,varargin)
%SHOW_S2_PARTITION 3D illustration of an EQ partition of S^2
%
%Syntax
% [movie_frame] = show_s2_partition(N,options);
%
%Description
% SHOW_S2_PARTITION(N) uses a 3d plot to illustrate the partition of
% the unit sphere S^2 into N regions.
%
% MOVIE_FRAME = SHOW_S2_PARTITION(N) sets MOVIE_FRAME to be an array of
% movie frames for use with MOVIE. The movie frames will contain the region by
% region build-up of the illustration.
%
% SHOW_S2_PARTITION(N,'offset','extra') uses experimental extra offsets.
% For more detail on partition options, see HELP PARTITION_OPTIONS.
%
% SHOW_S2_PARTITION(N,options) also recognizes a number of illustration
% options, which are specified as name, value pairs.
% Any number of pairs can be used, in any order.
%
% The following illustration options are used.
%
% SHOW_S2_PARTITION(N,'fontsize',size)
% Font size used in titles (numeric, default 16).
%
% SHOW_S2_PARTITION(N,'title','show')
% SHOW_S2_PARTITION(N,'title','hide')
% Show or hide title (default 'show').
%
% SHOW_S2_PARTITION(N,'points','show')
% SHOW_S2_PARTITION(N,'points','hide')
% Show or hide center points (default 'show').
%
% SHOW_S2_PARTITION(N,'sphere','show')
% SHOW_S2_PARTITION(N,'sphere','hide')
% Show or hide the unit sphere S^2 (default 'show').
%
% For more detail on illustration options, see HELP ILLUSTRATION_OPTIONS.
%
%Examples
% > show_s2_partition(10)
% > frames=show_s2_partition(9,'offset','extra')
% frames =
% 1x10 struct array with fields:
%     cdata
%     colormap
% > show_s2_partition(99,'points','hide')
%
%See also
% MOVIE, PARTITION_OPTIONS, ILLUSTRATION_OPTIONS, PROJECT_S2_PARTITION

% Copyright 2004-2005 Paul Leopardi for the University of New South Wales.
% $Revision 1.10 $ $Date 2005-06-01 $
% Function changed name from s2x to polar2cart
% Documentation files renamed
% $Revision 1.00 $ $Date 2005-02-13 $
%
% For licensing, see COPYING.
% For references, see AUTHORS.
% For revision history, see CHANGELOG.

pdefault.extra_offset =  false;
popt = partition_options(pdefault, varargin{:});

gdefault.fontsize = 16;
gdefault.show_title  = true;
gdefault.show_points = true;
gdefault.show_sphere = true;
gopt = illustration_options(gdefault, varargin{:});

dim = 2;

surf_jet;

if gopt.show_title
    if gopt.show_points
        pointstr = ', showing the center point of each region';
    else
        pointstr = '';
    end
    titlestr = sprintf(...
        '\nRecursive zonal equal area partition of {S^2} \n into %d regions%s.',...
        N,pointstr);
    title(titlestr,'FontWeight','bold','FontUnits','normalized',...
        'FontSize',gopt.fontsize/512);
end

frame_no = 1;
if nargout > 0
    movie_frame(frame_no) = getframe(gcf);
    frame_no = frame_no + 1;
end

if gopt.show_sphere
    show_s2_sphere;
    hold on
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

R = eq_regions(dim,N,popt.extra_offset);
top_colat = 0;
for i = N:-1:2
    if top_colat ~= R(2,1,i)
        top_colat = R(2,1,i);
        pause(0);
    end
    show_s2_region(R(:,:,i),N);
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

if gopt.show_points
    x = eq_point_set(dim,N,popt.extra_offset);
    show_r3_point_set(x,'sphere','hide','title','hide');
    hold on
    if nargout > 0
        movie_frame(frame_no) = getframe(gcf);
        frame_no = frame_no + 1;
    end
end

hold off
%
% end function

function show_s2_region(region,N)
%SHOW_S2_REGION Illustrate a region of S^2
%
%Syntax
% show_s2_region(region,N);
%
%Description
% SHOW_S2_REGION(REGION,N) uses 3D surface plots to illustrate a region of S^2.
% The region is given as a 2 x 2 matrix in spherical polar coordinates

tol = eps*2^5;

dim = size(region,1);
t = region(:,1);
b = region(:,2);

if abs(b(1)) < tol
    b(1) = 2*pi;
end
pseudo = 0;
if abs(t(1)) < tol && abs(b(1)-2*pi) < tol
    pseudo = 1;
end
n = 21;
delta = 1/(n-1);
h = 0:delta:1;
t_to_b = zeros(dim,n);
b_to_t = t_to_b;
r = sqrt(1/N)/12;
for k = 1:dim
    if ~pseudo || k < 2
        L = 1:dim;
        j(L) = mod(k+L,dim)+1;
        t_to_b(j(1),:) = t(j(1))+(b(j(1))-t(j(1)))*h;
        t_to_b(j(2),:) = t(j(2))*ones(1,n);
        t_to_b_x = polar2cart(t_to_b);
        [X,Y,Z] = fatcurve(t_to_b_x,r);
        surface(X,Y,Z,-ones(size(Z)),...
       'FaceColor','interp','FaceLighting','phong','EdgeColor','none')
        axis equal
        hold on
    end
end
grid off
axis off
%
% end function


function prob_test162 ( )

%*****************************************************************************80
%
%% TEST162 tests ZIPF_SAMPLE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  nsample = 1000;
  seed = 123456789;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST162\n' );
  fprintf ( 1, '  For the Zipf PDF:\n' );
  fprintf ( 1, '  ZIPF_SAMPLE samples.\n' );

  a = 4.0;

  check = zipf_check ( a );

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

  mean = zipf_mean ( a );
  variance = zipf_variance ( a );

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

  for i = 1 : nsample
    [ x(i), seed ] = zipf_sample ( a, seed );
  end

  mean = i4vec_mean ( nsample, x );
  variance = i4vec_variance ( nsample, x );
  xmax = max ( x(1:nsample) );
  xmin = min ( x(1:nsample) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Sample size =     %6d\n', nsample );
  fprintf ( 1, '  Sample mean =     %14f\n', mean );
  fprintf ( 1, '  Sample variance = %14f\n', variance );
  fprintf ( 1, '  Sample maximum =  %6d\n', xmax );
  fprintf ( 1, '  Sample minimum =  %6d\n', xmin );

  return
end


 function sn = nufft_scale(Nd, Kd, alpha, beta, Nmid)
%function sn = nufft_scale(Nd, Kd, alpha, beta, Nmid)
%|
%| Compute scaling factors for NUFFT
%|
%| in
%|	Nd,Kd
%|	alpha	{d}
%|	beta	{d}
%|
%| option
%|	Nmid	[d]		midpoint: floor(Nd/2) or default (Nd-1)/2
%|
%| out
%|	sn	[[Nd]]		scaling factors
%|
%| Copyright 2004-7-8, Jeff Fessler, University of Michigan

if nargin == 1 && streq(Nd, 'test'), nufft_scale_test, return, end
if nargin < 4, ir_usage, end

if nargin < 5, Nmid = (Nd-1)/2; end

dd = length(Nd);
if dd == 1 && ~iscell(alpha) % 1D case
	sn = nufft_scale1(Nd(1), Kd(1), alpha, beta, Nmid(1));
return
end

% scaling factors: "outer product" of 1D vectors
sn = 1;
for id=1:dd
	tmp = nufft_scale1(Nd(id), Kd(id), alpha{id}, beta{id}, Nmid(id));
	sn = sn(:) * tmp';
end
if length(Nd) > 1
	sn = reshape(sn, Nd);	% [(Nd)]
else
	sn = sn(:);	% [(Nd)]
end

% Compute scaling factors for 1D NUFFT (from Fourier series coefficients)
% in:
%	N,K
%	alpha
%	beta
% out:
%	sn	[N]		scaling factors
%
% Copyright 2001-10-4, Jeff Fessler, The University of Michigan

function sn = nufft_scale1(N, K, alpha, beta, Nmid)

if ~isreal(alpha(1)), error 'need real alpha_0', end
L = length(alpha) - 1;

%
% compute scaling factors from Fourier coefficients
%
if L > 0
	sn = zeros(N,1);
	n = [0:(N-1)]';
	i_gam_n_n0 = 1i * (2*pi/K) * (n - Nmid) * beta;

	for l1=-L:L
		alf = alpha(abs(l1)+1);
		if l1 < 0, alf = conj(alf); end
		sn = sn + alf * exp(i_gam_n_n0 * l1);
	end

else
	sn = alpha * ones(N,1);
end

% self test
function nufft_scale_test

N = 100;
K = 2*N;
alpha = [1.0 -0.0 -0.2];
sn = nufft_scale(N, K, alpha, 1);
if im
	n = [0:(N-1)]';
	clf, plot(n, real(sn), 'r-', n, imag(sn), 'b-')
	ir_legend({'$s[n]$ real', '$s[n]$ imag'})
	ylabelf('$s[n]$')
	xlabelf('$n$')
end

pr minmax(real(sn))
pr minmax(imag(sn))


function coeffs = alias(coeffs, m)
%ALIAS   Alias Chebyshev coefficients on the 1st kind Chebyshev grid.
%   ALIAS(C, M) aliases the Chebyshev coefficients stored in the column vector C
%   to have length M. If M > LENGTH(C), the coefficients are padded with zeros.
%   If C is a matrix of coefficients, each of the columns is aliased to length
%   M.
%
% See also PROLONG.

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Note that the formula for aliasing on the 1st-kind Chebyshev grid is
% different from that for the 2nd-kind grid, even though the coefficients
% being aliased are for 1st-kind Chebyshev polynomials in both cases.
%
% Useful References:
%   Fox, L. and Parker, I. B., Chebyshev polynomials in Numerical Analysis,
%   Oxford University Press, 1972.  (pp. 67)
%
%   Mason, J. C. and Handscomb, D. C., Chebyshev polynomials, Chapman &
%   Hall/CRC, Boca Raton, FL, 2003.  (pp. 153)
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

n = size(coeffs, 1);

% Pad with zeros:
if ( m > n )
    coeffs = [ coeffs ; zeros(m-n, size(coeffs, 2)) ];
    return
end

% Alias coefficients:
if ( m == 1 )
    % Reduce to a single point:
    e = ones(1, ceil(n/2));
    e(2:2:end) = -1;
    coeffs = e*coeffs(1:2:end,:);
elseif ( m > n/2 )
    % If m > n/2, only single coefficients are aliased, and we can vectorise.
    j = ((m + 1):n).';
    k = abs(mod(j + m - 2, 2*m) - m + 1) + 1;
    p = floor((j-1+m)/(2*m));
    t = (-1).^p;
    coeffs(k,:) = coeffs(k,:) + bsxfun(@times, t, coeffs(j,:));
else
    % Otherwise we must do everything in a tight loop. (Which is slower!)
    for j = (m + 1):n
        k = abs(mod(j + m - 2, 2*m) - m + 1) + 1;
        sgn = 1 - 2*mod(floor((j - 1 + m)/(2*m)), 2);
        coeffs(k,:) = coeffs(k,:) + sgn*coeffs(j,:);
    end
end

% Truncate:
coeffs = coeffs(1:m,:);

end


function element_neighbor = triangulation_neighbor_elements ( ...
  element_order, element_num, element_node )

%*****************************************************************************80
%
%% TRIANGULATION_NEIGHBOR_ELEMENTS determines element neighbors.
%
%  Discussion:
%
%    A triangulation of a set of nodes can be completely described by
%    the coordinates of the nodes, and the list of nodes that make up
%    each element.  However, in some cases, it is necessary to know
%    element adjacency information, that is, which element, if any,
%    is adjacent to a given element on a particular side.
%
%    This routine creates a data structure recording this information.
%
%    The primary amount of work occurs in sorting a list of 3 * ELEMENT_NUM
%    data items.
%
%    This routine was modified to use columns instead of rows.
%
%  Example:
%
%    The input information from ELEMENT_NODE:
%
%    Element    Nodes
%    --------   ---------------
%     1         3      4      1
%     2         3      1      2
%     3         3      2      8
%     4         2      1      5
%     5         8      2     13
%     6         8     13      9
%     7         3      8      9
%     8        13      2      5
%     9         9     13      7
%    10         7     13      5
%    11         6      7      5
%    12         9      7      6
%    13        10      9      6
%    14         6      5     12
%    15        11      6     12
%    16        10      6     11
%
%    The output information in ELEMENT_NEIGHBOR:
%
%    Element   Neighboring Elements
%    --------  ---------------------
%
%     1        -1     -1      2
%     2         1      4      3
%     3         2      5      7
%     4         2     -1      8
%     5         3      8      6
%     6         5      9      7
%     7         3      6     -1
%     8         5      4     10
%     9         6     10     12
%    10         9      8     11
%    11        12     10     14
%    12         9     11     13
%    13        -1     12     16
%    14        11     -1     15
%    15        16     14     -1
%    16        13     15     -1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    29 August 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer ELEMENT_ORDER, the order of the element.
%
%    Input, integer ELEMENT_NUM, the number of element.
%
%    Input, integer ELEMENT_NODE(ELEMENT_ORDER,ELEMENT_NUM), the nodes that
%    make up each element.
%
%    Output, integer ELEMENT_NEIGHBOR(3,ELEMENT_NUM), the three elements that are direct
%    neighbors of a given element.  ELEMENT_NEIGHBOR(1,I) is the index of the element
%    which touches side 1, defined by nodes 2 and 3, and so on.  ELEMENT_NEIGHBOR(1,I)
%    is negative if there is no neighbor on that side.  In this case, that
%    side of the element lies on the boundary of the triangulation.
%

%
%  Step 1.
%  From the list of nodes for element E, of the form: (I,J,K)
%  construct the three neighbor relations:
%
%    (I,J,3,E) or (J,I,3,E),
%    (J,K,1,E) or (K,J,1,E),
%    (K,I,2,E) or (I,K,2,E)
%
%  where we choose (I,J,3,E) if I < J, or else (J,I,3,E)
%
  col = zeros ( 4, 3 * element_num );

  for element = 1 : element_num

    i = element_node(1,element);
    j = element_node(2,element);
    k = element_node(3,element);

    if ( i < j )
      col(1:4,1+3*(element-1)) = [ i, j, 3, element ]';
    else
      col(1:4,1+3*(element-1)) = [ j, i, 3, element ]';
    end

    if ( j < k )
      col(1:4,2+3*(element-1)) = [ j, k, 1, element ]';
    else
      col(1:4,2+3*(element-1)) = [ k, j, 1, element ]';
    end

    if ( k < i )
      col(1:4,3+3*(element-1)) = [ k, i, 2, element ]';
    else
      col(1:4,3+3*(element-1)) = [ i, k, 2, element ]';
    end

  end
%
%  Step 2. Perform an ascending dictionary sort on the neighbor relations.
%  We only intend to sort on rows 1 and 2; the routine we call here
%  sorts on rows 1 through 4 but that won't hurt us.
%
%  What we need is to find cases where two elements share an edge.
%  Say they share an edge defined by the nodes I and J.  Then there are
%  two columns of COL that start out ( I, J, ?, ? ).  By sorting COL,
%  we make sure that these two columns occur consecutively.  That will
%  make it easy to notice that the elements are neighbors.
%
  col = i4col_sort_a ( 4, 3*element_num, col );
%
%  Step 3. Neighboring elements show up as consecutive columns with
%  identical first two entries.  Whenever you spot this happening,
%  make the appropriate entries in ELEMENT_NEIGHBOR.
%
  element_neighbor(1:3,1:element_num) = -1;

  icol = 1;

  while ( 1 )

    if ( 3 * element_num <= icol )
      break
    end

    if ( col(1,icol) ~= col(1,icol+1) || col(2,icol) ~= col(2,icol+1) )
      icol = icol + 1;
      continue
    end

    side1 = col(3,icol);
    element1 =  col(4,icol);
    side2 = col(3,icol+1);
    element2 =  col(4,icol+1);

    element_neighbor(side1,element1) = element2;
    element_neighbor(side2,element2) = element1;

    icol = icol + 2;

  end

  return
end


% Small technical example.
% Performs a check on the computation of certain central moments
% on a quincunx grid.
%
disp('Small technical example.');
disp('Performs a check on the computation of certain central moments');
disp('on a quincunx grid.');
disp('FOR MORE INFORMATION:  help Q0011mupq');
disp(' ');
disp('See also the report http://repository.cwi.nl:8888/cwi_repository/docs/IV/04/04178D.pdf');
disp('Dr. Paul M. de Zeeuw <Paul.de.Zeeuw@cwi.nl>');
disp(' (C) 1998-2006 Stichting CWI, Amsterdam, The Netherlands');
disp(' ');
%---INSERT YOUR IMAGE HERE-----------------------------------------------------
if exist('imread','file') == 2
  Orig = double(imread('zenithgray.TIF','tiff'));
else
  load zenithgray; Orig = zenithgray; clear zenithgray;
end
%
disp([' Dimensions ' int2str( size(Orig) )]);
%---EXTRACT A QUINCUNX GRIDFUNCTION-----
F00 = getcolor00(Orig);
F11 = getcolor11(Orig);
disp('The dimensions of the extracted quincunx gridfunction read as follows');
disp([int2str(size(F00)) ' and ' int2str(size(F11))]);
%
%---COMPUTE MASS------------------------
mu00 = Q0011mupq(F00, F11, 0, 0);
disp([' Mass  ' num2str( mu00, '%+12.4e')]);
%---NICE CHECK: OUTCOME SHOULD VANISH---
mu10 = Q0011mupq(F00, F11, 1, 0);
disp(' NICE CHECK: First order central moment (x-dir) should vanish');
disp([' reads ' num2str( mu10, '%+12.4e')]);
%---NICE CHECK: OUTCOME SHOULD VANISH---
mu01 = Q0011mupq(F00, F11, 0, 1);
disp(' NICE CHECK: First order central moment (y-dir) should vanish');
disp([' reads ' num2str( mu01, '%+12.4e')]);


function [y] = temporal_agg_p(z,op1,sc)
% PURPOSE: Temporal aggregation of a time series preserving its dimension
% ------------------------------------------------------------
% SYNTAX: y = temporal_agg_p(z,op1,sc);
% ------------------------------------------------------------
% OUTPUT: y: nx1 temporally aggregated series, missing=0
% ------------------------------------------------------------
% INPUT:  z: nx1 ---> vector of high frequency data
%         op1: type of temporal aggregation
%         op1=1 ---> sum (flow)
%         op1=2 ---> average (index)
%         op1=3 ---> last element (stock) ---> interpolation
%         op1=4 ---> first element (stock) ---> interpolation
%         sc: number of high frequency data points
%            for each low frequency data points
%         Note: n = sc x N
% ------------------------------------------------------------
% LIBRARY: aggreg
% ------------------------------------------------------------

% written by:
%  Enrique M. Quilis
%  Macroeconomic Research Department
%  Ministry of Economy and Competitiveness
%  <enrique.quilis@mineco.es>
% Version 1.0 [October 2010]

[n,m] = size(z);

% ------------------------------------------------------------
% Computes the number of low frequency points.
% Low frequency periods should be complete

N = fix(n/sc);
C = aggreg_p(op1,n,sc);

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

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

y = C*z;


function [t,s]=zerocros(x,m)
%ZEROCROS finds the zeros crossings in a signal [T,S]=(X,M)% find zero crossings in a signal
% Inputs:  x = input waveform
%          m = mode string containing:
%              'p' - positive crossings only
%              'n' - negative crossings only
%              'b' - both (default)
%              'r' - round to integer values
%
% Outputs: t = sample positions of zero crossings (not necessarily integers)
%          s = estimated slope of x at the zero crossing
%
% This routine uses linear interpolation to estimate the position of a zero crossing
% A zero crossing occurs between x(n) and x(n+1) iff (x(n)>=0) ~= (x(n+1)>=0)

% Example: x=sin(2*pi*(0:1000)/200); x(1:100:1001)=0; zerocros(x);
% Note that we get a zero crossing at the end but not at the start.

%	   Copyright (C) Mike Brookes 2003-2015
%      Version: $Id: zerocros.m 6077 2015-04-20 07:08:39Z dmb $
%
%   VOICEBOX is a MATLAB toolbox for speech processing.
%   Home page: http://www.ee.ic.ac.uk/hp/staff/dmb/voicebox/voicebox.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   This program is free software; you can redistribute it and/or modify
%   it under the terms of the GNU General Public License as published by
%   the Free Software Foundation; either version 2 of the License, or
%   (at your option) any later version.
%
%   This program is distributed in the hope that it will be useful,
%   but WITHOUT ANY WARRANTY; without even the implied warranty of
%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%   GNU General Public License for more details.
%
%   You can obtain a copy of the GNU General Public License from
%   http://www.gnu.org/copyleft/gpl.html or by writing to
%   Free Software Foundation, Inc.,675 Mass Ave, Cambridge, MA 02139, USA.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

if nargin<2
    m='b';
end
s=x>=0;
k=s(2:end)-s(1:end-1);
if any(m=='p')
    f=find(k>0);
elseif any(m=='n')
    f=find(k<0);
else
    f=find(k~=0);
end
s=x(f+1)-x(f);
t=f-x(f)./s;
if any(m=='r')
    t=round(t);
end
if ~nargout
    n=length(x);
    plot(1:n,x,'-',t,zeros(length(t),1),'o');
end


function [im_x, im_y] = project( camera, world_X, world_Y, world_Z )
%PROJECT: project a 3D point into an image
%
%   [IM_X,IM_Y] = PROJECT(CAMERA,WORLD_X,WORLD_Y,WORLD_Z) projects one or
%   more 3D point in the world coordinate frame into image coordinates

%   Copyright 2005-2009 The MathWorks, Inc.
%   $Revision: 1.0 $    $Date: 2006/06/30 00:00:00 $

z = camera.rawP(3,1) * world_X ...
    + camera.rawP(3,2) * world_Y ...
    + camera.rawP(3,3) * world_Z ...
    + camera.rawP(3,4);
im_y = round( (camera.rawP(2,1) * world_X ...
    + camera.rawP(2,2) * world_Y ...
    + camera.rawP(2,3) * world_Z ...
    + camera.rawP(2,4)) ./ z);
im_x = round( (camera.rawP(1,1) * world_X ...
    + camera.rawP(1,2) * world_Y ...
    + camera.rawP(1,3) * world_Z ...
    + camera.rawP(1,4)) ./ z);


% Copyright (C) Daphne Koller, Stanford University, 2012

function EU = SimpleCalcExpectedUtility(I)

  % Inputs: An influence diagram, I (as described in the writeup).
  %         I.RandomFactors = list of factors for each random variable.  These are CPDs, with
  %              the child variable = D.var(1)
  %         I.DecisionFactors = factor for the decision node.
  %         I.UtilityFactors = list of factors representing conditional utilities.
  % Return Value: the expected utility of I
  % Given a fully instantiated influence diagram with a single utility node and decision node,
  % calculate and return the expected utility.  Note - assumes that the decision rule for the
  % decision node is fully assigned.

  % In this function, we assume there is only one utility node.
  F = [I.RandomFactors I.DecisionFactors];
  U = I.UtilityFactors(1);
  EU = [];
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  %
  % YOUR CODE HERE
  %
  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  Fnew = VariableElimination(F,setdiff(unique([F.var]),U.var));
  %Fnew = F;
  out = Fnew(1);
  for i = 2:length(Fnew)
	  out = FactorProduct(out,Fnew(i));
  end

  hha = U;
  hha.val = ones(1,length(U.val));
  out = FactorProduct(hha,out);
  U = FactorProduct(hha,U);
  %out = FactorMarginalization(out,setdiff(unique([F.var]),U.var));

EU = [sum(out.val.*U.val)];

end


function lik = lik_multinom(varargin)
%LIK_MULTINOM  Create a multinomial likelihood structure
%
%  Description
%    LIK = LIK_MULTINOM creates multinomial likelihood for multi-class
%    count data. The observed numbers in each class with C classes is
%    given as 1xC vector.
%
%    The likelihood is defined as follows:
%                              __ n                __ C
%      p(y|f^1, ..., f^C, z) = || i=1 [ gamma(N+1) || c=1 p_i^c^(y_i^c)/gamma(y_i^c+1)]
%
%    where p_i^c = exp(f_i^c)/ (sum_c=1^C exp(f_i^c)) is the succes
%    probability for class c, which is a function of the latent variable
%    f_i^c for the corresponding class and N=sum(y) is the number of trials.
%
%  See also
%    GP_SET, LIK_*
%
% Copyright (c) 2010 Jaakko Riihimäki, Pasi Jylänki
% Copyright (c) 2010 Aki Vehtari
% Copyright (c) 2010 Jarno Vanhatalo

% This software is distributed under the GNU General Public
% License (version 3 or later); please refer to the file
% License.txt, included with the software, for details.

  ip=inputParser;
  ip.FunctionName = 'LIK_MULTINOM';
  ip.addOptional('lik', [], @isstruct);
  ip.parse(varargin{:});
  lik=ip.Results.lik;

  if isempty(lik)
    init=true;
    lik.type = 'Multinom';
    lik.nondiagW = true;
  else
    if ~isfield(lik,'type') || ~isequal(lik.type,'Multinom')
      error('First argument does not seem to be a valid likelihood function structure')
    end
    init=false;
  end

  if init
    % Set the function handles to the subfunctions
    lik.fh.pak = @lik_multinom_pak;
    lik.fh.unpak = @lik_multinom_unpak;
    lik.fh.ll = @lik_multinom_ll;
    lik.fh.llg = @lik_multinom_llg;
    lik.fh.llg2 = @lik_multinom_llg2;
    lik.fh.llg3 = @lik_multinom_llg3;
    lik.fh.tiltedMoments = @lik_multinom_tiltedMoments;
    lik.fh.predy = @lik_multinom_predy;
    lik.fh.invlink = @lik_multinom_invlink;
    lik.fh.recappend = @lik_multinom_recappend;
  end

end

function [w,s,h] = lik_multinom_pak(lik)
%LIK_MULTINOM_PAK  Combine likelihood parameters into one vector.
%
%  Description
%    W = LIK_MULTINOM_PAK(LIK) takes a likelihood structure LIK and
%    returns an empty verctor W. If Multinom likelihood had
%    parameters this would combine them into a single row vector
%    W (see e.g. lik_negbin). This is a mandatory subfunction used
%    for example in energy and gradient computations.
%
%
%  See also
%    LIK_MULTINOM_UNPAK, GP_PAK

  w = []; s = {};h=[];
end

function [lik, w] = lik_multinom_unpak(lik, w)
%LIK_MULTINOM_UNPAK  Extract likelihood parameters from the vector.
%
%  Description
%    W = LIK_MULTINOM_UNPAK(W, LIK) Doesn't do anything.
%
%    If Multinom likelihood had parameters this would extracts them
%    parameters from the vector W to the LIK structure. This is a
%    mandatory subfunction used for example in energy and gradient
%    computations.
%
%
%  See also
%    LIK_MULTINOM_PAK, GP_UNPAK

  lik=lik;
  w=w;
end

function ll = lik_multinom_ll(lik, y, f, z)
%LIK_MULTINOM_LL  Log likelihood
%
%  Description
%    LL = LIK_MULTINOM_LL(LIK, Y, F) takes a likelihood structure
%    LIK, class counts Y (NxC matrix), and latent values F (NxC
%    matrix). Returns the log likelihood, log p(y|f,z). This
%    subfunction is needed when using Laplace approximation or
%    MCMC for inference with non-Gaussian likelihoods. This
%    subfunction is also used in information criteria
%    (DIC, WAIC) computations.
%
%  See also
%    LIK_MULTINOM_LLG, LIK_MULTINOM_LLG3, LIK_MULTINOM_LLG2, GPLA_E

  f=reshape(f,size(y));
  expf = exp(f);
  p = expf ./ repmat(sum(expf,2),1,size(expf,2));
  N = sum(y,2);

  ll = sum(gammaln(N+1) - sum(gammaln(y+1),2) + sum(y.*log(p),2) );

end

function llg = lik_multinom_llg(lik, y, f, param, z)
%LIK_MULTINOM_LLG    Gradient of the log likelihood
%
%  Description
%    LLG = LIK_MULTINOM_LLG(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F. Returns
%    the gradient of the log likelihood with respect to PARAM. At
%    the moment PARAM can be 'param' or 'latent'. This subfunction
%    is needed when using Laplace approximation or MCMC for inference
%    with non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG2, LIK_MULTINOM_LLG3, GPLA_E

  f=reshape(f,size(y));
  C = size(y,2);
  expf2 = exp(f);
  N=sum(y, 2);
  pi2 = (N*ones(1,C)).*expf2./(sum(expf2, 2)*ones(1,C));
  pi_vec=pi2(:);
  llg = y(:)-pi_vec;

end

function [pi_vec, pi_mat] = lik_multinom_llg2(lik, y, f, param, z)
%LIK_MULTINOM_LLG2  Second gradients of the log likelihood
%
%  Description
%    LLG2 = LIK_MULTINOM_LLG2(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F. Returns
%    the Hessian of the log likelihood with respect to PARAM. At
%    the moment PARAM can be only 'latent'. LLG2 is a vector with
%    diagonal elements of the Hessian matrix (off diagonals are
%    zero). This subfunction is needed when using Laplace
%    approximation or EP for inference with non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG, LIK_MULTINOM_LLG3, GPLA_E

% multinom:
  [n,nout]=size(y);
  N = sum(y,2)*ones(1,nout);
  f=reshape(f,n,nout);

  expf2 = exp(f);
  pi2 = expf2./(sum(expf2, 2)*ones(1,nout));
  pi_vec=pi2(:).*N(:);

  pi_mat=zeros(nout*n, n);
  for i1=1:nout
    pi_mat((1+(i1-1)*n):(nout*n+1):end)=pi2(:,i1).*sqrt(N(:,i1));
  end
  %     D = diag(pi_vec);
  %     llg2 = -D + pi_mat*pi_mat';

end

function [dw_mat] = lik_multinom_llg3(lik, y, f, param, z)
%LIK_MULTINOM_LLG3  Third gradients of the log likelihood
%
%  Description
%    LLG3 = LIK_MULTINOM_LLG3(LIK, Y, F, PARAM) takes a likelihood
%    structure LIK, class labels Y, and latent values F and
%    returns the third gradients of the log likelihood with
%    respect to PARAM. At the moment PARAM can be only 'latent'.
%    LLG3 is a vector with third gradients. This subfunction is
%    needed when using Laplace approximation for inference with
%    non-Gaussian likelihoods.
%
%  See also
%    LIK_MULTINOM_LL, LIK_MULTINOM_LLG, LIK_MULTINOM_LLG2, GPLA_E, GPLA_G

  [n,nout] = size(y);
  f2 = reshape(f,n,nout);

  N=sum(y, 2);
  expf2 = exp(f2);
  pi2 = expf2./(sum(expf2, 2)*ones(1,nout));
  pi_vec=pi2(:);

  dw_mat=zeros(nout,nout,nout,n);

  for cc3=1:nout
    for ii1=1:n

      pic=pi_vec(ii1:n:(nout*n));
      for cc1=1:nout
        for cc2=1:nout

          % multinom third derivatives
          cc_sum_tmp=0;
          if cc1==cc2 && cc1==cc3 && cc2==cc3
            cc_sum_tmp=cc_sum_tmp+pic(cc1);
          end
          if cc1==cc2
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc3);
          end
          if cc2==cc3
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc2);
          end
          if cc1==cc3
            cc_sum_tmp=cc_sum_tmp-pic(cc1)*pic(cc2);
          end
          cc_sum_tmp=cc_sum_tmp+2*pic(cc1)*pic(cc2)*pic(cc3);

          dw_mat(cc1,cc2,cc3,ii1)=cc_sum_tmp.*N(ii1);
        end
      end
    end
  end

end

function [logM_0, m_1, sigm2hati1] = lik_multinom_tiltedMoments(lik, y, i1, S2_i, M_i, z)
    %LIK_COXPH_TILTEDMOMENTS  Returns the marginal moments for EP algorithm
    %
    %  Description
    %    [M_0, M_1, M2] = LIK_COXPH_TILTEDMOMENTS(LIK, Y, I, S2,
    %    MYY, Z) takes a likelihood structure LIK, class labels
    %    Y, index I and cavity variance S2 and
    %    mean MYY. Returns the zeroth moment M_0, mean M_1 and
    %    variance M_2 of the posterior marginal (see Rasmussen and
    %    Williams (2006): Gaussian processes for Machine Learning,
    %    page 55). This subfunction is needed when using EP for
    %    inference with non-Gaussian likelihoods.
    %
    %  See also
    %    GPEP_E

    error('tiltedMoment has not been implemented for multinom likelihood');

end

function [lpy, Ey, Vary] = lik_multinom_predy(lik, Ef, Varf, yt, zt)
%LIK_MULTINOM_PREDY  Returns the predictive mean, variance and density of y
%
%  Description
%    LPY = LIK_MULTINOM_PREDY(LIK, EF, VARF YT)
%    Returns logarithm of the predictive density PY of YT, that is
%        p(yt | y) = \int p(yt | f) p(f|y) df.
%    This requires also the incedence counts YT. This subfunction
%    is needed when computing posterior predictive distributions for
%    future observations.
%
%    [LPY, EY, VARY] = LIK_MULTINOM_PREDY(LIK, EF, VARF, YT) takes a
%    likelihood structure LIK, posterior mean EF and posterior
%    Variance VARF of the latent variable and returns the
%    posterior predictive mean EY and variance VARY of the
%    observations related to the latent variables. This subfunction
%    is needed when computing posterior predictive distributions for
%    future observations.
%

%
%  See also
%    GPLA_PRED, GPEP_PRED, GPMC_PRED

  N=sum(yt,2);
  S=10000;
  [ntest, nout]=size(yt);
  pi=zeros(ntest,nout);
  lpy=zeros(ntest,nout);
  Ey=zeros(ntest,nout);
  Vary=zeros(size(Varf));
  Ef=reshape(Ef(:),ntest,nout);
  [notused,notused,c] =size(Varf);
  if c>1
    mcmc=false;
  else
    mcmc=true;
    Varf=reshape(Varf(:), ntest, nout);
  end
  for i1=1:ntest
    if mcmc
      Sigm_tmp = (Varf(i1,:));
      f_star=bsxfun(@plus, Ef(i1,:), bsxfun(@times, sqrt(Sigm_tmp), ...
        randn(S,nout)));
    else
      Sigm_tmp=(Varf(:,:,i1)'+Varf(:,:,i1))./2;
      f_star=mvnrnd(Ef(i1,:), Sigm_tmp, S);
    end

    tmp = exp(f_star);
    tmp = tmp./(sum(tmp, 2)*ones(1,size(tmp,2)));

    if nargout > 1
        Ey(i1,:) = N(i1).*mean(tmp);
        for z1 = 1:nout;
          for z2 = 1:nout
            for z3=1:S
              Var_tmp(:,:,z3) = (diag(tmp(z3,:)) - tmp(z3,:)'*tmp(z3,:));
            end
            if mcmc
              Vary(i1+(0:nout-1)*ntest,:) = diag(N(i1).*mean(Var_tmp,3));
            else
              Vary(:,:,i1) = N(i1).*mean(Var_tmp,3);
            end
          end
        end
    end
    lpy=[];
    if ~isempty(yt)
      ytmp = repmat(yt(i1,:),S,1);
      lpy(i1,:) = log(mean( mnpdf(ytmp,tmp) ));
    end
  end
  lpy=lpy(:);
  Ey=Ey(:);
  Vary=Vary(:);
end

function p = lik_multinom_invlink(lik, f, z)
%LIK_MULTINOM_INVLINK Returns values of inverse link function
%
%  Description
%    P = LIK_MULTINOM_INVLINK(LIK, F) takes a likelihood structure LIK and
%    latent values F and returns the values of inverse link function P.
%    This subfunction is needed when using function gp_predprctmu.
%
%     See also
%     LIK_MULTINOM_LL, LIK_MULTINOM_PREDY
p = multinominv(f).*z;
end

function reclik = lik_multinom_recappend(reclik, ri, lik)
%RECAPPEND  Append the parameters to the record
%
%  Description
%    RECLIK = LIK_MULTINOM_RECAPPEND(RECLIK, RI, LIK) takes a
%    likelihood record structure RECLIK, record index RI and
%    likelihood structure LIK with the current MCMC samples of
%    the parameters. Returns RECLIK which contains all the old
%    samples and the current samples from LIK. This subfunction
%    is needed when using MCMC sampling (gp_mc).
%
%  See also
%    GP_MC

  if nargin == 2
    reclik.type = 'Multinom';
    reclik.nondiagW = true;

    % Set the function handles
    reclik.fh.pak = @lik_multinom_pak;
    reclik.fh.unpak = @lik_multinom_unpak;
    reclik.fh.ll = @lik_multinom_ll;
    reclik.fh.llg = @lik_multinom_llg;
    reclik.fh.llg2 = @lik_multinom_llg2;
    reclik.fh.llg3 = @lik_multinom_llg3;
    reclik.fh.tiltedMoments = @lik_multinom_tiltedMoments;
    reclik.fh.predy = @lik_multinom_predy;
    reclik.fh.invlink = @lik_multinom_invlink;
    reclik.fh.recappend = @lik_multinom_recappend;
  end

end


function err = getL2error(node,elem,uexact,uh,quadOrder,varargin)
%% GETL2ERROR L2 norm of the approximation error.
%
%  err = getL2error(node,elem,@uexact,uh) computes the L2 norm of the error
%  between the exact solution uexact and a finite element approximation uh
%  on a mesh described by node and elem.
%
%  The input parameter uexact is a function handle and uh is a column array
%  which could be:
%    - P0 element i.e. discontinuous and piecewise constant
%    - P1 element i.e. continuous and piecewise linear
%    - CR element i.e. piecewise linear and continuous at mid pts of edges
%    - P2 element i.e. continuous and piecewise quadratic
%    - P1+P0 element which could happen in the fluid application
%
%  err = getL2error(node,elem,@uexact,uh,quadOrder) computes error
%  using the quadrature rule with order quadOrder (up to 5). The default
%  order is 3.
%
%  Example: compute L2 error of piecewise linear interpolation
%
%     [node,elem] = squaremesh([0,1,0,1],0.25);
%     for k = 1:4
%         exactu = inline('sin(pi*pxy(:,1)).*sin(pi*pxy(:,2))','pxy');
%         uI = exactu(node);
%         N(k) = size(node,1);
%         err(k) = getL2error(node,elem,exactu,uI);
%         [node,elem] = uniformrefine(node,elem);
%     end
%     showrate(N,err);
%
% The cubic element is added by Jie Zhou.
%
% See also getH1error, getL2error3, getH1error3, quadpts.
%
% Copyright (C) Long Chen. See COPYRIGHT.txt for details.

Nu = length(uh);    N = size(node,1);   NT = size(elem,1);
% Euler formula N-NE+NT = c % rough estimateus using Euler formula
NE = N + NT;    NP2 = N + NE;   NP3 = N + 2*NE + NT;
%% Default quadrature orders for different elements
if Nu > N+NT-5
    elem2dof = dofP2(elem);
    NP2 = max(elem2dof(:));
    NE = NP2 - N;
    NP3 = N+2*NE+NT;
end

%% Default quadrature orders for different elements
if ~exist('quadOrder','var')
    switch Nu
        case NT     % piecewise constant function P0
            quadOrder = 2;
        case N      % piecewise linear function P1 element
            quadOrder = 3;
        case NE     % piecewise linear function CR element
            quadOrder = 3;
        case N+NT   % piecewise linear function + constant function
            quadOrder = 3;
        case NP2    % piecewise quadratic function
            quadOrder = 4;
        case NE+NT  % weak Galerkin element
            quadOrder = 3;
        case NP3    % P3 element
            quadOrder = 5;
    end
end

%% compute L2 error element-wise using quadrature rule with order quadOrder
err = zeros(NT,1);
[lambda,weight] = quadpts(quadOrder);
% basis function at quadrature points
switch Nu
    case N    % P1 piecewise linear function
        phi = lambda; % linear bases
    case N+NT % P1+P0
        phi = lambda; % linear bases
    case NE  % CR nonconforming P1 element
        phi = 1-2*lambda;
        elem2edge = elem2dof(:,4:6) - N;
    case NP2 % P2 piecewise quadratic elements
        phi(:,1) = lambda(:,1).*(2*lambda(:,1)-1);
        phi(:,2) = lambda(:,2).*(2*lambda(:,2)-1);
        phi(:,3) = lambda(:,3).*(2*lambda(:,3)-1);
        phi(:,4) = 4*lambda(:,2).*lambda(:,3);
        phi(:,5) = 4*lambda(:,1).*lambda(:,3);
        phi(:,6) = 4*lambda(:,2).*lambda(:,1);
    case NE+NT  % weak Galerkin element
%             uhp = uh(1:NT); % only count the interior part
        phi = 1-2*lambda;
        elem2edge = elem2dof(:,4:6) - N + NT;
    case 2*NE+NT+N % P3 piecewise cubic elements
        phi(:,1) = 0.5*(3*lambda(:,1)-1).*(3*lambda(:,1)-2).*lambda(:,1);
        phi(:,2) = 0.5*(3*lambda(:,2)-1).*(3*lambda(:,2)-2).*lambda(:,2);
        phi(:,3) = 0.5*(3*lambda(:,3)-1).*(3*lambda(:,3)-2).*lambda(:,3);
        phi(:,4) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,2)-1);
        phi(:,5) = 9/2*lambda(:,3).*lambda(:,2).*(3*lambda(:,3)-1);
        phi(:,6) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,3)-1);
        phi(:,7) = 9/2*lambda(:,1).*lambda(:,3).*(3*lambda(:,1)-1);
        phi(:,8) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,1)-1);
        phi(:,9) = 9/2*lambda(:,1).*lambda(:,2).*(3*lambda(:,2)-1);
        phi(:,10) = 27*lambda(:,1).*lambda(:,2).*lambda(:,3);
        elem2dof = dofP3(elem);
end
nQuad = size(lambda,1);
for p = 1:nQuad
    % evaluate uh at quadrature point
    switch Nu
        case NT   % P0 piecewise constant function
            uhp = uh;
        case N    % P1 piecewise linear function
            uhp = uh(elem(:,1))*phi(p,1) + ...
                  uh(elem(:,2))*phi(p,2) + ...
                  uh(elem(:,3))*phi(p,3);
        case N+NT % P1+P0
            uhp = uh(elem(:,1))*phi(p,1) + ...
                  uh(elem(:,2))*phi(p,2) + ...
                  uh(elem(:,3))*phi(p,3);
            uhp = uhp + uh(N+1:end);
        case NE  % CR nonconforming P1 element
            uhp = uh(elem2edge(:,1))*phi(p,1) + ...
                  uh(elem2edge(:,2))*phi(p,2) + ...
                  uh(elem2edge(:,3))*phi(p,3);
        case NP2 % P2 piecewise quadratic function
            uhp = uh(elem2dof(:,1)).*phi(p,1) + ...
                  uh(elem2dof(:,2)).*phi(p,2) + ...
                  uh(elem2dof(:,3)).*phi(p,3) + ...
                  uh(elem2dof(:,4)).*phi(p,4) + ...
                  uh(elem2dof(:,5)).*phi(p,5) + ...
                  uh(elem2dof(:,6)).*phi(p,6);
        case NP3
            uhp = uh(elem2dof(:,1)).*phi(p,1) + ...
                  uh(elem2dof(:,2)).*phi(p,2) + ...
                  uh(elem2dof(:,3)).*phi(p,3) + ...
                  uh(elem2dof(:,4)).*phi(p,4) + ...
                  uh(elem2dof(:,5)).*phi(p,5) + ...
                  uh(elem2dof(:,6)).*phi(p,6) + ...
                  uh(elem2dof(:,7)).*phi(p,7) + ...
                  uh(elem2dof(:,8)).*phi(p,8) + ...
                  uh(elem2dof(:,9)).*phi(p,9) + ...
                  uh(elem2dof(:,10)).*phi(p,10);
        case NE+NT  % weak Galerkin element
%             uhp = uh(1:NT); % only count the interior part
            uhp = uh(elem2edge(:,1))*phi(p,1) + ...
                  uh(elem2edge(:,2))*phi(p,2) + ...
                  uh(elem2edge(:,3))*phi(p,3);
    end
    % quadrature points in the x-y coordinate
    pxy = lambda(p,1)*node(elem(:,1),:) ...
        + lambda(p,2)*node(elem(:,2),:) ...
        + lambda(p,3)*node(elem(:,3),:);
    err = err + weight(p)*(uexact(pxy) - uhp).^2;
end
%% Modification
% area of triangles
ve2 = node(elem(:,1),:)-node(elem(:,3),:);
ve3 = node(elem(:,2),:)-node(elem(:,1),:);
area = 0.5*abs(-ve3(:,1).*ve2(:,2)+ve3(:,2).*ve2(:,1));
err = area.*err;
err(isnan(err)) = 0; % singular values, i.e. uexact(p) = infty, are excluded
err = sqrt(sum(err));


function [A,E,Y] = singular_value_rpca( D, lambda, tau, delta, svdMethod, A0)

%   Solves the Robust PCA relaxation
%
%      min  \tau ( |A|_* + \lambda |E|_1 ) + 1/2 |(A,E)|_F^2
%      subj  A+E = D
%
%   by iterative thresholding.
%
%   Inputs:
%      D      -- the data matrix, m x n.
%      lambda -- relative weight of sparsity of error
%
%   Optional:
%      tau    -- magnitude of L2 relaxation of the pure robust PCA SDP,
%                 higher value is desirable.
%      delta  -- stepsize, should be in (0,1).
%      svdMethod -- SVD routine to be used in each iteration, must be one
%                    of 'svdlibc', 'propack', or 'svds'. If not any of
%                    these, default option is MATLAB's svd command. (May
%                    require additional library dependencies if custom routine is used.)
%      A0 -- true low-rank solution, if known, to enable better display of
%            progress in each iteration.
%
%   Outputs:
%      A      -- estimate of the low-rank generating matrix
%      E      -- estimate of the error or corruption
%
%   Winter '08, John Wright, Shankar Rao. Questions? jnwright@uiuc.edu
%
%   Copyright: Perception and Decision Laboratory
%			University of Illinois, Urbana-Champaign

VERBOSE                         = 2;
EPSILON_PRIMAL                  = 5e-4;

if nargin < 5,  svdMethod = 'svd'; end

if nargin < 4,  delta = 0.9; end;

if nargin < 3, tau = 1e4; end;

MAX_ITER                        = 25000;
DISPLAY_EVERY                   = 100;

[m,n] = size(D);

Y = zeros(m,n);  % Lagrange multiplier
A = zeros(m,n);  % Structure
E = zeros(m,n);  % Error

rankA = 0;

iter      = 0;
converged = false;

while ~converged
    iter = iter + 1;

    switch lower(svdMethod)
        case 'svdlibc'
            [U,diagS,V] = svdlibc(Y, rankA+1);
        case 'propack'
            [U,S,V] = lansvd(Y,rankA+1,'L');
            diagS = diag(S);
        case 'svds'
            [U,S,V] = svds(Y, rankA+1, 'L');
            diagS = diag(S);
        otherwise
            [U,S,V] = svd(Y,0);
            diagS = diag(S);
    end

    A = U * diag(pos(diagS-tau)) * V';
    E = sign(Y) .* pos( abs(Y) - lambda*tau );
    M = D - A - E;

    rankA  = sum(diagS>tau);
    cardE = sum(sum(double(abs(E)>0)));

    Y = Y + delta * M;

%     if VERBOSE > 1 && mod(iter, DISPLAY_EVERY)==0 && nargin>=6,
%         disp(['    Iteration '    num2str(iter)               ...
%             ' |A|_F '         num2str(norm(A,'fro'))      ...
%             ' rank(A) '         num2str(rankA)              ...
%             ' |E|_F '         num2str(norm(E,'fro'))      ...
%             ' |E|_0 '         num2str(cardE) ...
%             ' |D-A-E|_F ' num2str(norm(M,'fro')) ...
%             ' |A-A0|_F / |A0|_F ' num2str(norm(A-A0,'fro')/norm(A0,'fro')) ...
%             ' |D-A-E|_1,inf ' num2str(max(max(abs(M)))) ]);
%     elseif VERBOSE > 0 && mod(iter, DISPLAY_EVERY)==0,
%         disp(['    Iteration '    num2str(iter)               ...
%             ' rank(A) '         num2str(rankA) ...
%             ' ||E||_0 ' num2str(cardE) ]);
%     end

    if ( norm(D-A-E,'fro')/norm(D,'fro') < EPSILON_PRIMAL || iter >= MAX_ITER )
        converged = true;
    end

%     if ( iter >= MAX_ITER )
%         disp('Maximum number of iterations reached.') ;
%     end

end


function [p,ellipse]=phantom3d(varargin)

%PHANTOM3D Three-dimensional analogue of MATLAB Shepp-Logan phantom
%   P = PHANTOM3D(DEF,N) generates a 3D head phantom that can
%   be used to test 3-D reconstruction algorithms.
%
%   DEF is a string that specifies the type of head phantom to generate.
%   Valid values are:
%
%      'Shepp-Logan'            A test image used widely by researchers in
%                               tomography
%      'Modified Shepp-Logan'   (default) A variant of the Shepp-Logan phantom
%                               in which the contrast is improved for better
%                               visual perception.
%
%   N is a scalar that specifies the grid size of P.
%   If you omit the argument, N defaults to 64.
%
%   P = PHANTOM3D(E,N) generates a user-defined phantom, where each row
%   of the matrix E specifies an ellipsoid in the image.  E has ten columns,
%   with each column containing a different parameter for the ellipsoids:
%
%     Column 1:  A      the additive intensity value of the ellipsoid
%     Column 2:  a      the length of the x semi-axis of the ellipsoid
%     Column 3:  b      the length of the y semi-axis of the ellipsoid
%     Column 4:  c      the length of the z semi-axis of the ellipsoid
%     Column 5:  x0     the x-coordinate of the center of the ellipsoid
%     Column 6:  y0     the y-coordinate of the center of the ellipsoid
%     Column 7:  z0     the z-coordinate of the center of the ellipsoid
%     Column 8:  phi    phi Euler angle (in degrees) (rotation about z-axis)
%     Column 9:  theta  theta Euler angle (in degrees) (rotation about x-axis)
%     Column 10: psi    psi Euler angle (in degrees) (rotation about z-axis)
%
%   For purposes of generating the phantom, the domains for the x-, y-, and
%   z-axes span [-1,1].  Columns 2 through 7 must be specified in terms
%   of this range.
%
%   [P,E] = PHANTOM3D(...) returns the matrix E used to generate the phantom.
%
%   Class Support
%   -------------
%   All inputs must be of class double.  All outputs are of class double.
%
%   Remarks
%   -------
%   For any given voxel in the output image, the voxel's value is equal to the
%   sum of the additive intensity values of all ellipsoids that the voxel is a
%   part of.  If a voxel is not part of any ellipsoid, its value is 0.
%
%   The additive intensity value A for an ellipsoid can be positive or negative;
%   if it is negative, the ellipsoid will be darker than the surrounding pixels.
%   Note that, depending on the values of A, some voxels may have values outside
%   the range [0,1].
%
%   Example
%   -------
%        ph = phantom3d(128);
%        figure, imshow(squeeze(ph(64,:,:)))
%
%   Copyright 2005 Matthias Christian Schabel (matthias @ stanfordalumni . org)
%   University of Utah Department of Radiology
%   Utah Center for Advanced Imaging Research
%   729 Arapeen Drive
%   Salt Lake City, UT 84108-1218
%
%   This code is released under the Gnu Public License (GPL). For more information,
%   see : http://www.gnu.org/copyleft/gpl.html
%
%   Portions of this code are based on phantom.m, copyrighted by the Mathworks
%

[ellipse,n] = parse_inputs(varargin{:});

p = zeros([n n n]);

rng =  ( (0:n-1)-(n-1)/2 ) / ((n-1)/2);

[x,y,z] = meshgrid(rng,rng,rng);

coord = [flatten(x); flatten(y); flatten(z)];

p = flatten(p);

for k = 1:size(ellipse,1)
   A = ellipse(k,1);            % Amplitude change for this ellipsoid
   asq = ellipse(k,2)^2;        % a^2
   bsq = ellipse(k,3)^2;        % b^2
   csq = ellipse(k,4)^2;        % c^2
   x0 = ellipse(k,5);           % x offset
   y0 = ellipse(k,6);           % y offset
   z0 = ellipse(k,7);           % z offset
   phi = ellipse(k,8)*pi/180;   % first Euler angle in radians
   theta = ellipse(k,9)*pi/180; % second Euler angle in radians
   psi = ellipse(k,10)*pi/180;  % third Euler angle in radians

   cphi = cos(phi);
   sphi = sin(phi);
   ctheta = cos(theta);
   stheta = sin(theta);
   cpsi = cos(psi);
   spsi = sin(psi);

   % Euler rotation matrix
   alpha = [cpsi*cphi-ctheta*sphi*spsi   cpsi*sphi+ctheta*cphi*spsi  spsi*stheta;
            -spsi*cphi-ctheta*sphi*cpsi  -spsi*sphi+ctheta*cphi*cpsi cpsi*stheta;
            stheta*sphi                  -stheta*cphi                ctheta];

   % rotated ellipsoid coordinates
   coordp = alpha*coord;

   idx = find((coordp(1,:)-x0).^2./asq + (coordp(2,:)-y0).^2./bsq + (coordp(3,:)-z0).^2./csq <= 1);
   p(idx) = p(idx) + A;
end

p = reshape(p,[n n n]);

return;

function out = flatten(in)

out = reshape(in,[1 prod(size(in))]);

return;

function [e,n] = parse_inputs(varargin)
%  e is the m-by-10 array which defines ellipsoids
%  n is the size of the phantom brain image

n = 128;     % The default size
e = [];
defaults = {'shepp-logan', 'modified shepp-logan', 'yu-ye-wang'};

for i=1:nargin
   if ischar(varargin{i})         % Look for a default phantom
      def = lower(varargin{i});
      idx = strmatch(def, defaults);
      if isempty(idx)
         eid = sprintf('Images:%s:unknownPhantom',mfilename);
         msg = 'Unknown default phantom selected.';
         error(eid,'%s',msg);
      end
      switch defaults{idx}
      case 'shepp-logan'
         e = shepp_logan;
      case 'modified shepp-logan'
         e = modified_shepp_logan;
      case 'yu-ye-wang'
         e = yu_ye_wang;
      end
   elseif numel(varargin{i})==1
      n = varargin{i};            % a scalar is the image size
   elseif ndims(varargin{i})==2 && size(varargin{i},2)==10
      e = varargin{i};            % user specified phantom
   else
      eid = sprintf('Images:%s:invalidInputArgs',mfilename);
      msg = 'Invalid input arguments.';
      error(eid,'%s',msg);
   end
end

% ellipse is not yet defined
if isempty(e)
   e = modified_shepp_logan;
end

return;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Default head phantoms:   %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function e = shepp_logan

e = modified_shepp_logan;
e(:,1) = [1 -.98 -.02 -.02 .01 .01 .01 .01 .01 .01];

return;

function e = modified_shepp_logan
%
%   This head phantom is the same as the Shepp-Logan except
%   the intensities are changed to yield higher contrast in
%   the image.  Taken from Toft, 199-200.
%
%         A      a     b     c     x0      y0      z0    phi  theta    psi
%        -----------------------------------------------------------------
e =    [  1  .6900  .920  .810      0       0       0      0      0      0
        -.8  .6624  .874  .780      0  -.0184       0      0      0      0
        -.2  .1100  .310  .220    .22       0       0    -18      0     10
        -.2  .1600  .410  .280   -.22       0       0     18      0     10
         .1  .2100  .250  .410      0     .35    -.15      0      0      0
         .1  .0460  .046  .050      0      .1     .25      0      0      0
         .1  .0460  .046  .050      0     -.1     .25      0      0      0
         .1  .0460  .023  .050   -.08   -.605       0      0      0      0
         .1  .0230  .023  .020      0   -.606       0      0      0      0
         .1  .0230  .046  .020    .06   -.605       0      0      0      0 ];

return;

function e = yu_ye_wang
%
%   Yu H, Ye Y, Wang G, Katsevich-Type Algorithms for Variable Radius Spiral Cone-Beam CT
%
%         A      a     b     c     x0      y0      z0    phi  theta    psi
%        -----------------------------------------------------------------
e =    [  1  .6900  .920  .900      0       0       0      0      0      0
        -.8  .6624  .874  .880      0       0       0      0      0      0
        -.2  .4100  .160  .210   -.22       0    -.25    108      0      0
        -.2  .3100  .110  .220    .22       0    -.25     72      0      0
         .2  .2100  .250  .500      0     .35    -.25      0      0      0
         .2  .0460  .046  .046      0      .1    -.25      0      0      0
         .1  .0460  .023  .020   -.08    -.65    -.25      0      0      0
         .1  .0460  .023  .020    .06    -.65    -.25     90      0      0
         .2  .0560  .040  .100    .06   -.105    .625     90      0      0
        -.2  .0560  .056  .100      0    .100    .625      0      0      0 ];

return;


 function cost = qpwls_cost(xs, G, W, yy, C, mask)
%function cost = qpwls_cost(xs, G, W, yy, C, mask)
% compute QPWLS cost for each column of x
%
% Copyright Apr 1999, Jeff Fessler

if nargin < 3, ir_usage, end

if nargin == 6
	xs = reshape(xs, size(xs,1)*size(xs,2), size(xs,3));
	xs = xs(find(mask(:)), :);
end

cost = zeros(ncol(xs),1);
for kk=1:ncol(xs)
	x = xs(:,kk);
	resid = yy - G * x;	% predicted measurements
	cost(kk) = resid' * W * resid / 2 + norm(C * x).^2 / 2;
end

cost = reale(cost);	% trick: x'*x is not real for complex values


function out = SY_RangeEvolve(y)
% SY_RangeEvolve    How the time-series range changes across time.
%
% Measures of the range of the time series as a function of time,
% i.e., range(x_{1:i}) for i = 1, 2, ..., N, where N is the length of the time
% series.
%
%---INPUT:
% y, the time series
%
%---OUTPUTS: based on the dynamics of how new extreme events occur with time.

% ------------------------------------------------------------------------------
% Copyright (C) 2020, Ben D. Fulcher <ben.d.fulcher@gmail.com>,
% <http://www.benfulcher.com>
%
% If you use this code for your research, please cite the following two papers:
%
% (1) B.D. Fulcher and N.S. Jones, "hctsa: A Computational Framework for Automated
% Time-Series Phenotyping Using Massive Feature Extraction, Cell Systems 5: 527 (2017).
% DOI: 10.1016/j.cels.2017.10.001
%
% (2) B.D. Fulcher, M.A. Little, N.S. Jones, "Highly comparative time-series
% analysis: the empirical structure of time series and their methods",
% J. Roy. Soc. Interface 10(83) 20130048 (2013).
% DOI: 10.1098/rsif.2013.0048
%
% This function 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.
%
% This program is distributed in the hope that it will be useful, but WITHOUT
% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
% FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
% details.
%
% You should have received a copy of the GNU General Public License along with
% this program. If not, see <http://www.gnu.org/licenses/>.
% ------------------------------------------------------------------------------

doPlot = false; % whether to plot outputs
N = length(y); % length of the time series
cums = zeros(N,1);

for i = 1:N
    cums(i) = range(y(1:i));
end
% cums = cums/range(y);

if doPlot
    figure('color','w');
    plot(cums);
end

fullr = range(y);

% Define an anonymous function for the number of unique entries in a vector, x:
lunique = @(x) length(unique(x));

out.totnuq = lunique(cums);

% How many of the unique extrema are in first <proportion> of time series?
cumtox = @(x) lunique(cums(1:floor(N*x)))/out.totnuq;
out.nuqp1 = cumtox(0.01);
out.nuqp10 = cumtox(0.1);
out.nuqp20 = cumtox(0.2);
out.nuqp50 = cumtox(0.5);

% (**1**) how many unique extrema are in first <length> of time series

Ns = [10, 50, 100, 1000];
for i = 1:length(Ns)
    if N >= Ns(i)
        out.(sprintf('nuql%u',Ns(i))) = lunique(cums(1:Ns(i)))/out.totnuq;
    else
        out.(sprintf('nuql%u',Ns(i))) = NaN;
    end
end

% (**2**) Actual proportion of full range captured at different points

out.p1 = cums(ceil(N*0.01))/fullr;
out.p10 = cums(ceil(N*0.1))/fullr;
out.p20 = cums(ceil(N*0.2))/fullr;
out.p50 = cums(ceil(N*0.5))/fullr;

Ns = [10, 50, 100, 1000];
for i = 1:length(Ns)
    if N >= Ns(i)
        out.(sprintf('l%u',Ns(i))) = cums(Ns(i))/fullr;
    else
        out.(sprintf('l%u',Ns(i))) = NaN;
    end
end

end


function [Z,A,B,rss] = arch2(X, na, mode, sil)

%   [Z,A,B,rss] = arch2(X, na, mode, silent )
%
%   archetypal analysis of column orientated data set <X>
%
%   input arguments :
%
%   - each column of data is one 'observation', e.g. the sample values of
%     all channels in a multichannel measurement at one point in time
%
%   - na : number of generated archetypes
%
%   - mode can be one of the following : 'normalized' (default),
%     'mean', 'raw'
%     - in mode 'normalized' each column of data is centered by removing its mean
%       and then normalized by dividing through its standard deviation before
%       the covariance matrix is calculated
%     - in mode 'mean' only the mean of every column of data is removed
%     - in mode 'raw' no preprocessing is applied to data
%     - in mode 'scale' <X> is divided by max(abs(X))
%
%   - silent is an optional flag which supresses output of text and plot on the matlab
%     screen. Returned values (see below) are in no way affected
%
%
%   output arguments :
%
%   - Z : each column of Z is an archetype
%
%   - A : the columns of A are the coefficients of the archetypes to
%         the constrains ||X-Z*A|| -> min
%
%   - B : the columns of B create the X-mixtures (the archtypes)
%         Z=X*B
%
%   - rss : the residual sum of squares for each iteration
%
%   Christian Merkwirth & Joerg Wichard
%   Februar 1998

global silent

narginchk(2,3);

if nargin < 3
    mode = 'normalized';
end

if nargin < 4
    silent = 0;
else
    silent = 1;
end

[m,n] = size(X);

printline('archetypal analysis')
printline(['on data set of size ' num2str(n) 'x' num2str(m)]);

if (na < 1)
  printline('number of archetypes must be greater than zero');
end

if strncmp(mode, 'r',1)
  mode = 'raw';
  printline('no data preprocessing');
elseif strncmp(mode, 'm',1)
  mode = 'mean';
  printline('removing mean from data set');
  mn = mean(X,2);
  X = X - repmat(mn, 1, n);
elseif strncmp(mode, 's',1)
  mode = 'scale';
  printline('scaling data set');
  xm = max(max(abs(X)));
  X = (1/xm)*X;
else
  mode = 'normalized';
  printline('removing mean and normalizing data');
  mn = mean(X,2);
  X = X - repmat(mn, 1, n);
  dv = std(X,0,2);
  X = X ./ repmat(dv, 1, n);
end

gew1=20*m;              % Gewichtung der Convexit�tsbedingung
gew2=5*m;               % Gewichtung der Convexit�tsbedingung
tol=0.01;              %%Toleranz f�r die Abbruchbedingung
numb = 20;              %% Max. Anzahl der Iterationen

%%  x zuf�llig ausw�len
B=eye(n);
rp=randperm(na);
B=B(:,rp);
Z=X*B;

%% Hier beginnt die Alternierende Optimierung
rss(1,:)=[ 0 sum(sum(X .* X))]
count=0;

for c=1:numb;

  for l=1:na;

    %% Maximum an Z anf�gen
    MX=max(max(Z));
    Z(m+1,:)=gew1*MX;
    X(m+1,:)=gew1*MX;

    %% A suchen bei konstantem Z
    for i=1:n;
      A(:,i)= lsqnonneg(Z,X(:,i));
    end;

    %% Gewichtung entfernen
    X=X(1:m,:);
    Z=Z(1:m,:);

    %% Z suchen bei konstantem A
    for i=1:n;
      V(:,i)=A(l,i)*(X(:,i) - Z*A(:,i) + A(l,i)*Z(:,l));
    end;

    %% Singul�re Archetypen durch max ||X-Z*A|| ersetzen
    if ( (sum(A(l,:)) .* sum(A(l,:))) ==0)
      VT=sum((X-Z*A).*(X-Z*A));
      [VTC,VTI]=max(VT);
      B(:,l)=0;
      B(VTI,l)=1;

    else
      VS=(sum(A(l,:).*A(l,:)))*sum(V,2);
      MV=max(max(X));
      X(m+1,:)=gew2*MV;
      VS(m+1)=gew2*MV;

      B(:,l)=nnls(X,VS, 4 * max(size(X)) * norm(X,1) * eps);

      %% Gewichtung entfernen
      X=X(1:m,:);
      VS=VS(1:m);
    end;
  end;

  Z=X*B;

  %% norm RSS berechnen
  rss((c+1),:)=[ c sum(sum((X-Z*A).*(X-Z*A))) ];

  if (abs(rss(c+1,2)-rss(c,2)) < tol*rss(c,2) )
    break;
  end;

  count=count+1;
end;

%% Ergebnis auf Konsistenz �berpr�fen
[C,I]=max(rss);
if( (I < count) & (rss(I) < rss(count)) )
  printline('Minimum not reached')
end

if( count == numb )
  printline('Maximum Number of Iterations')
end

if silent
  figure(1)
  subplot(4,1,1)
  plot(rss(:,1), rss(:,2))
  title('Residual Sum of Squares')

  subplot(4,1,2)
  plot(X)
  title('Input Data');

  subplot(4,1,3)
  plot((Z),'k')
  title('Archetypes');

  subplot(4,1,4)
  plot((Z),'k')
  hold on;
  plot(X)
  hold off;
  title('Archetypes & Input Data');
end

function printline(string)
global silent
if silent~=1
        disp(string)
end


%% Copyright (C) 2014, 2016, 2019 Colin B. Macdonald
%%
%% This file is part of OctSymPy.
%%
%% OctSymPy 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.
%%
%% This software is distributed in the hope that it will be useful,
%% but WITHOUT ANY WARRANTY; without even the implied warranty
%% of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
%% the GNU General Public License for more details.
%%
%% You should have received a copy of the GNU General Public
%% License along with this software; see the file COPYING.
%% If not, see <http://www.gnu.org/licenses/>.

%% -*- texinfo -*-
%% @documentencoding UTF-8
%% @defmethod @@sym trace (@var{A})
%% Trace of symbolic matrix.
%%
%% Example:
%% @example
%% @group
%% syms x
%% A = [1 2 x; 3 sym(pi) 4; 13 5 2*x]
%%   @result{} A = (sym 3×3 matrix)
%%       ⎡1   2   x ⎤
%%       ⎢          ⎥
%%       ⎢3   π   4 ⎥
%%       ⎢          ⎥
%%       ⎣13  5  2⋅x⎦
%% trace(A)
%%   @result{} ans = (sym) 2⋅x + 1 + π
%% @end group
%% @end example
%%
%% As an example, we can check that the trace of the product is @emph{not}
%% the product of the traces:
%% @example
%% @group
%% A = sym([1 2; 3 4]);
%% B = sym([pi 3; 1 8]);
%% trace(A*B)
%%   @result{} ans = (sym) π + 43
%% trace(A) * trace(B)
%%   @result{} ans = (sym) 5⋅π + 40
%% @end group
%% @end example
%% However, such a property does hold if we use the Kronecker tensor product
%% (@pxref{@@sym/trace}):
%% @example
%% @group
%% kron(A, B)
%%   @result{} ans = (sym 4×4 matrix)
%%       ⎡ π   3   2⋅π  6 ⎤
%%       ⎢                ⎥
%%       ⎢ 1   8    2   16⎥
%%       ⎢                ⎥
%%       ⎢3⋅π  9   4⋅π  12⎥
%%       ⎢                ⎥
%%       ⎣ 3   24   4   32⎦
%% trace(kron(A, B))
%%   @result{} ans = (sym) 5⋅π + 40
%% trace(A) * trace(B)
%%   @result{} ans = (sym) 5⋅π + 40
%% @end group
%% @end example
%%
%% @seealso{@@sym/det}
%% @end defmethod

function z = trace(x)

  cmd = { 'x, = _ins'
          'if not x.is_Matrix:'
          '    x = sp.Matrix([[x]])'
          'return sp.trace(x),' };

  z = pycall_sympy__ (cmd, x);

end

%!test
%! % scalar
%! syms x
%! assert (isequal (trace(x), x))

%!test
%! syms x
%! A = [x 3; 2*x 5];
%! assert (isequal (trace(A), x + 5))


%% Configurable Simulink Model for DC-DC Converters
%

%% DC-DC Converters
% There are three kinds of switching mode DC-DC converters, buck, boost and
% buck-boost. The buck mode is used to reduce output voltage, whilst the
% boost mode can increase the output voltage. In the buck-boost mode, the
% output voltage can be maintained either higher or lower than the source
% but in the opposite polarity. The simplest forms of these converters are
% schematically represented in Figure 1.

%%
%
%
%
%
% Figure 1. Buck (left), Boost (middle) and Buck-Boost (right) converters.

%%
% These converters consist of the same components, an inductor, $L$, a
% capacitor, $C$ and a switch, which has two states  $u=1$ and $u=0$. All
% converters connect to a DC power source with a voltage (unregulated),
% $V_\mathrm{in}$ and provide a regulated voltage, $v_\mathrm{o}$ to the
% load resistor, $R$ by controlling the state of the switch. In some
% situations, the load also could be inductive, for example a DC motor, or
% approximately, a current load, for example in a cascade configuration.
% For simplicity, here, only current and resistive loads are to be
% considered.
%

%% Principles
% The working principles of the these DC-DC converters can be explained as
% follows. In the buck mode, when the switch is on position 1, the DC
% source supplies power to the circuit which results an output voltage
% across the resistor. When the switch changes its position to 0, the
% energy stored in the inductor and capacitor will discharge through the
% resistor. Appropriately controlling the switching position can maintain
% the output voltage at a desired level lower than the source.
%
% In the boost mode, when the switch is on position 1, the circuit is
% separated into two parts: on the left, the source is charging the
% inductor, meanwhile the capacitor on the right maintains the output
% voltage using previously stored energy. When the switch changes its
% position to 0, both the DC source and energy stored in the inductor will
% supply power to the circuit on the right, hence boost the output voltage.
% Again, the output voltage can be maintain at desired level by controlling
% the switching sequence.
%
% Finally, for the buck-boost mode, switch positions 1 and 0 represents
% charging and discharging modes of the inductor. Appropriately controlling
% the switching sequence can result in output voltage higher or lower than
% the DC source. Since the inductor cannot change the direction of current,
% the output voltage is opposite to the DC source.

%% Model under ideal assumptions
% Under ideal assumptions: ideal switch, ideal capacitor and ideal
% inductor, these converters can be described using ordinary
% differentiation equations as follows:
%
%% Buck converter:
% $C{dv_{c} \over dt} = i_{L} - v_{c}/R - i_{o}$
%
% $L{di_{L} \over dt} = uv_{in} - v_{c}$
%
% where, $i_\mathrm{o}$ is the load current.
%
%% Boost converter:
% $C{dv_\mathrm{c}\over dt}=(1-u)i_\mathrm{L}-v_\mathrm{c}/R-i_\mathrm{o}$
%
% $L{di_\mathrm{L}\over dt}=v_\mathrm{in} - (1-u) v_\mathrm{c}$
%
%% Buck-boost converter:
% $C{dv_\mathrm{c}\over dt}=(1-u)i_\mathrm{L}-v_\mathrm{c}/R-i_\mathrm{o}$
%
% $L{di_\mathrm{L}\over dt}=uv_\mathrm{in} - (1-u) v_\mathrm{c}$
%
% Introduce the following state, time and load normalization:
%
% $x_1={v_\mathrm{c}\over v_\mathrm{in}}$,
%
% $x_2={i_\mathrm{L}\over v_\mathrm{in}}\sqrt{{L}\over{C}}$,
%
% $\tau = {t \over \sqrt{LC}}$,
%
% $\gamma = {\sqrt{LC}\over R}$,
%
% $d = {i_\mathrm o \over v_\mathrm{in}}\sqrt{{L}\over {C}}$
%
% Then the normalized state equations of three converters are as follows:
%
%% Normalized buck model
% $\dot{x_1} = -\gamma x_1 + x_2 - d$
%
% $\dot{x_2}= -x_1 + u $
%
% where, with an abuse of notation, `.' represents the derivation with
% respect to the normalized time, $\tau$.
%
%% Normalized boost model
% $\dot{x_1} = -\gamma x_1 + (1-u)x_2 - d$
%
% $\dot{x_2} = -(1-u)x_1 + 1$
%
%% Normalized buck-boost model
% $\dot{x_1} = -\gamma x_1 + (1-u)x_2 -d$
%
% $\dot{x_2} = -(1-u)x_1 + u$
%

%% Model with body resistors
% In more general cases, a body resistor of the inductor, $R_\mathrm{L}$
% and an equivalent series resistor (ESR) of the capacitor, $R_\mathrm{c}$
% can be added to the above models.
%
%% Buck model with $R_\mathrm{L}$ and $R_\mathrm{c}$
% Since,
%
% $C{dv_\mathrm{c}\over dt} = i_\mathrm{L} - v_\mathrm{o}/R - i_\mathrm{o}$
%
% $v_\mathrm{o} = v_\mathrm{c} + R_\mathrm{c}C{dv_\mathrm{c}\over dt}$
%
% $L{di_\mathrm{L}\over dt} = uv_\mathrm{in} - v_\mathrm{o} -
% R_\mathrm{L}i_\mathrm{L}$
%
% Inserting the second equation into the first leads to:
%
% $C{dv_\mathrm{c}\over dt} = i_\mathrm{L} - v_\mathrm{c}/R -
% {R_\mathrm{c}\over R}C{dv_\mathrm{c}\over dt}- i_\mathrm{o}$
%
% $\left(1+{R_\mathrm{c}\over R}\right)C{dv_\mathrm{c}\over
% dt}=i_\mathrm{L} - v_\mathrm{c}/R - i_\mathrm{o}$
%
% Hence,
%
% $v_\mathrm{o}={Rv_\mathrm{c}\over R+R_\mathrm{c}}+{RR_\mathrm{c}\over
% R+R_\mathrm{c}}(i_\mathrm{L}-i_\mathrm{o})$
%
% and the overall model is
%
% $C{dv_\mathrm{c}\over dt}={R\over R+R_\mathrm{c}}\left(i_\mathrm{L} - {v_\mathrm{c}\over R} - i_\mathrm{o}\right)$
%
% $L{di_\mathrm{L}\over dt} = uv_\mathrm{in} - {Rv_\mathrm{c}\over
% R+R_\mathrm{c}} - \left(R_\mathrm{L}+{RR_\mathrm{c}\over R+R_\mathrm{c}}\right) i_\mathrm{L} + {RR_\mathrm{c}i_\mathrm{o}\over R+R_\mathrm{c}}$
%
% $v_\mathrm{o}={Rv_\mathrm{c}\over R+R_\mathrm{c}}+{RR_\mathrm{c}\over
% R+R_\mathrm{c}}(i_\mathrm{L}-i_\mathrm{o})$
%
%% Boost model with $R_\mathrm{L}$ and $R_\mathrm{c}$
% $C{dv_\mathrm{c}\over dt} = (1-u)i_\mathrm{L} - v_\mathrm{o}/R - i_\mathrm{o}$
%
% $L{di_\mathrm{L}\over dt} = v_\mathrm{in} - (1-u) v_\mathrm{o} - R_\mathrm{L}i_\mathrm{L}$
%
% $v_\mathrm{o} = {Rv_\mathrm{c}\over R+R_\mathrm{c}}+{RR_\mathrm{c}\over
% R+R_\mathrm{c}}((1-u)i_\mathrm{L}-i_\mathrm{o})$
%
%% Buck-boost model with $R_\mathrm{L}$ and $R_\mathrm{c}$
% $C{dv_\mathrm{c}\over dt} = (1-u)i_\mathrm{L} - v_\mathrm{o}/R-i_\mathrm{o}$
%
% $L{di_\mathrm{L}\over dt}=uv_\mathrm{in}-(1-u) v_\mathrm{o}-R_\mathrm{L}i_\mathrm{L}$
%
% $v_\mathrm{o}={Rv_\mathrm{c}\over R+R_\mathrm{c}}+{RR_\mathrm{c}\over R+R_\mathrm{c}}((1-u)i_\mathrm{L}-i_\mathrm{o})$
%
%% Simulink Model
% These three modes of DC-DC converters have been uniformly implemented in
% the MATLAB/Simulink as show in Figure~\ref{fig:simulinkmodel}.
%
% <<DCDCModelInside.png>>
%
% Figure 2. A uniform Simulink model of DC-DC converters.
%
% The input-output connections of the model is shown in Figure 3.
%
% <<DCDCModel.png>>
%
% Figure 3. Input and output connections of the DC-DC converter model.
%
% The first input to the model is the switch signal eight 1 or 0. The
% second one defines the DC source voltage and internal resistance. The
% third input is used to define the output current. The model has two
% outputs, the output voltage and the inductor current, which are the
% states of the system.
%
% The model can be configure with a number of parameters as shown in
% Figure~\ref{fig:simulinkmodelparameters}. These parameters are: the
% capacitance, $C$, inductance, $L$, the internal resistance of the
% capacitor and the inductor, $R_C$ and $R_L$ respectively. Three converter
% modes can be selected through the pull-down menu. One can also define
% either zero or non-zero value to the initial capacitor voltage by
% selecting or de-selecting the ``zero capacitor voltage'' option. Finally,
% the option ``Positive Inductor Current'' defines whether the condition
% $i_L\ge 0$ should be enforced or not.
%
% <<DCDCModelParameters.png>>
%
% Figure 4. Parameters of the DC-DC converter model.
%


function [y, dsdx, dsdp] = VBA_sigmoid(x, varargin)
% // VBA toolbox //////////////////////////////////////////////////////////
%
% [y, dsdx, dsdp] = VBA_sigmoid(x, [name, value, ...])
% Apply a sigmoid transformation to x
%
% By default, the canonical sigmoid is used:
%
%   y = 1 / (1 + exp(- x))
%
% However, this function can be parametrized using name/value pairs of
% arguments to get, using all options:
%
%   y = offset + scale * 1 / (1 + exp(- slope * (x - center))
%
% IN:
%   - x: values to be transformed
%   - optional key/value pairs or structure (or both) that parametrize the
%     sigmoid transformation:
%       * 'slope'     : inverse-temperature parameter (default = 1)
%       * 'center'    : absissa of the inflexion point (default = 0)
%       * 'scale'     : multiplicative gain of the transformation (default = 1)
%       * 'offset'    : additive gain (default = 0)
%       * 'lapseRate' : shotcut for offset = lapseRate and scale = 1 - 2 * lapseRate
%                       this option is incompatible with offset or scale
%   - other optional key/value pairs or structure (or both)
%       * 'inverse' : reversed transformation, ie. x = VBA_sigmoid(y, opt)
%                       (default = false)
%       * 'finite'  : boundaries that enforce precision to be finite and
%                     derivative to stay numerically non zero (default = 1e-9)
%                     Set to 0 to deactivate
%       * 'derivatives' : cell array of parameter names wrt which dsdp must be
%                         computed (in given order).
%
%
%   Note that if the 'inverse' flag is set to true, the derivatives will
%   not be computed and dsdx = dsdp = [] will be returned instead.
%
% OUT:
%   - y: transformed values, with the same dimension as x.
%   - dsdx: derivative of the transformation wrt. x, taken at each point x.
%     Has the same dimension as x.
%   - dsdp: derivative of the transformation wrt. the parameters specified
%     as arguments. Derivatives are for parameters taken in alphabetical
%     order and aggregated along the first dimension. For example, calling
%     VBA_sigmoid([x1; x2], 'slope', 2, 'center', 3) will return dsdp as:
%     [ d_s/d_center(x1) d_s/d_center(x2) ;
%       d_s/d_slope(x1)  d_s/d_slope(x2)  ]
%     If x is multidimensional, size(dsdp) = [nb_params, size(x,1), size(x,2), ...]
%
% /////////////////////////////////////////////////////////////////////////

%% Globals
% =========================================================================
% truncature for finite sigmoid
epsilon = 1e-9;

%% Shrtcut
% =========================================================================
% quick version!
if nargin == 1 && nargout == 1
    y = epsilon + (1 - 2 * epsilon) ./ (1 + exp (- x));
    return
end

%% Parse arguments
% =========================================================================

% define inputParser
% -------------------------------------------------------------------------
persistent parser;

if isempty (parser)
    parser = getParser ();
end

% parse arguments
% -------------------------------------------------------------------------

parser.parse (varargin{:});
params = parser.Results ;

% apply shortcuts if needed
% -------------------------------------------------------------------------

if ~ ismember ('lapseRate', parser.UsingDefaults)
    % lapseRate is mutually ex
    if any (~ ismember ({'offset', 'scale'}, parser.UsingDefaults))
        error('*** VBA_sigmoid: you can not specify lapseRate and offset or scale at the same time');
    end
    params.offset = params.lapseRate;
    params.scale = 1 - 2 * params.lapseRate;
end

%% Compute transformation
% =========================================================================

%% Inversed case
if params.inverse
    % check that values are valid
    if ~ VBA_isInRange(x, [0 1])
        error('*** VBA_sigmoid: inverse sigmoid inputs must be between 0 and 1');
    end

    % inverse sigmoid transformation
    lx = params.scale * (x - params.offset) .^-1  - 1;
    y = params.center - params.slope ^-1 * log (lx) ;

    % skip derivatives, they are generally not used in inverse case
    dsdx = [];
    dsdp = [];

%% Normal case
else
    % evaluate sigmoid
    % ---------------------------------------------------------------------
    sx = 1 ./ (1 + exp(- params.slope * (x - params.center)));
    y = params.offset + params.scale * sx;

    % ensure finite precision ('finite' flag)
    % ---------------------------------------------------------------------
    if params.finite > 0
        minY = params.offset + epsilon;
        y = max(y,minY);
        maxY = params.offset + params.scale - epsilon;
        y = min(y,maxY);
    end

    % compute derivatives with respect to value
    % ---------------------------------------------------------------------

    % skip if not not required
    if nargout < 2
        return
    end

    % actual computation
    dsdx = params.slope * (y - params.offset) .* (1 - (y - params.offset) ./ params.scale);

    % compute derivatives with respect to parameters
    % ---------------------------------------------------------------------

    % skip if not not required
    if nargout < 3
        return
    end

    % concatenate derivatives for all parameters
    dims = size(x);

    dsdp = cat (2, ...
        - VBA_vec (dsdx), ... % d_center
        1 - 2 * VBA_vec (sx), ... d_lapseRate
        ones(numel(sx),1), ... d_offset
        VBA_vec (sx), ... d_scale
        ((VBA_vec (x) - VBA_vec(params.center)) / params.slope) .* VBA_vec (dsdx) ... d_slope
        );

    % keep only those passed s parameter
    derivables = {'center','lapseRate','offset','scale','slope'};
    if isempty(params.derivatives)
         params.derivatives = setdiff(derivables, parser.UsingDefaults);
    end
    dIdx = cellfun(@(l) find(strcmp (derivables, l)), params.derivatives);

    dsdp = dsdp(:,dIdx);

    % set derived parameter as first dimension
    if all(dims == 1)
        dsdp = dsdp';
    else
        dims(dims==1) = [];
        dsdp = reshape(dsdp', [size(dsdp,2) dims]);
    end

end

end

function parser = getParser()

parser = inputParser;
parser.PartialMatching = false;
parser.KeepUnmatched = true;

% define parameters
% -------------------------------------------------------------------------

% flags
parser.addParameter ('inverse', false, @islogical);
parser.addParameter ('finite', true, @(z) VBA_isInRange(z, [0 1e-2]));
parser.addParameter ('derivatives', {}, @iscellstr);

% x transfomations
parser.addParameter ('slope', 1, @isnumeric);
parser.addParameter ('center', 0, @isnumeric);

% sig transformation
parser.addParameter ('offset', 0, @isnumeric);
parser.addParameter ('scale', 1, @(z) VBA_isInRange(z, [eps Inf]));

% shortcut for lapse rate model
parser.addParameter ('lapseRate', 0, @(z) VBA_isInRange(z, [0 0.5]));
end


function [ a, det ] = spodi ( a, lda, n, job )

%*****************************************************************************80
%
%% SPODI computes the determinant and inverse of a certain matrix.
%
%  Discussion:
%
%    The matrix is real symmetric positive definite.
%    SPODI uses the factors computed by SPOCO, SPOFA or SQRDC.
%
%    A division by zero will occur if the input factor contains
%    a zero on the diagonal and the inverse is requested.
%    It will not occur if the subroutines are called correctly
%    and if SPOCO or SPOFA has set INFO == 0.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 November 2006
%
%  Author:
%
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Dongarra, Moler, Bunch and Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%    ISBN 0-89871-172-X
%
%  Parameters:
%
%    Input, real A(LDA,N), the output A from SPOCO or SPOFA, or the output
%    X from SQRDC.
%
%    Input, integer LDA, the leading dimension of the array A.
%
%    Input, integer N, the order of the matrix A.
%
%    Input, integer JOB, specifies the task.
%    11, both determinant and inverse.
%    01, inverse only.
%    10, determinant only.
%
%    Output, real A(LDA,N), if SPOCO or SPOFA was used to factor A then
%    SPODI produces the upper half of inverse(A).  If SQRDC was used to
%    decompose X then SPODI produces the upper half of inverse(X'*X)
%    where X' is the transpose.  Elements of A below the diagonal are
%    unchanged.  If the units digit of JOB is zero, A is unchanged.
%
%    Output, real DET(2), the determinant of A or of X'*X
%    if requested.
%      determinant = DET(1) * 10.0**DET(2)
%    with 1.0 <= DET(1) < 10.0 or DET(1) == 0.0.
%

%
%  Compute the determinant.
%
  if ( job / 10 ~= 0 )

    det(1) = 1.0;
    det(2) = 0.0;
    s = 10.0;

    for i = 1 : n

      det(1) = a(i,i) * a(i,i) * det(1);

      if ( det(1) == 0.0 )
        break
      end

      while ( det(1) < 1.0 )
        det(1) = s * det(1);
        det(2) = det(2) - 1.0;
      end

      while ( s <= det(1) )
        det(1) = det(1) / s;
        det(2) = det(2) + 1.0;
      end

    end

  end
%
%  Compute inverse(R).
%
  if ( mod ( job, 10 ) ~= 0 )

    for k = 1 : n

      a(k,k) = 1.0 / a(k,k);
      t = -a(k,k);
      a(1:k-1,k) = sscal ( k-1, t, a(1:k-1,k), 1 );

      for j = k+1 : n
        t = a(k,j);
        a(k,j) = 0.0;
        a(1:k,j) = saxpy ( k, t, a(1:k,k), 1, a(1:k,j), 1 );
      end

    end
%
%  Form inverse(R) * (inverse(R))'.
%
    for j = 1 : n
      for k = 1 : j-1
        t = a(k,j);
        a(1:k,k) = saxpy ( k, t, a(1:k,j), 1, a(1:k,k), 1 );
      end
      t = a(j,j);
      a(1:j,j) = sscal ( j, t, a(1:j,j), 1 );
    end

  end

  return
end


function [Bdraw,statOK]=sampleB(yData,Psi,SV_H,A,p,priorValues)
% This function uses the method proposed by Carriero Clark and Marcellino
% to draw from the conditional posterior distribution of B.
%sampleB(yData,PsiDraw_prop,HvarsDraw_prop,Adraw_prop,p,priorValues)
%Psi = PsiDraw_prop; %local mean
%SV_H = HvarsDraw_prop; %draw for the time varrying diagonal elements of the VCV
%A = Adraw_prop;     %the time invariant component of the VCV

%% Initialize
[T,M] = size(yData);
Tp=T-p;

% expand prior data
varsH=priorValues.vars;
lambda=priorValues.lambda; %overall tightness
theta=priorValues.theta;   %extra shrinkage for off diagonal elements

%% set up prior variance and mean of B
% Prior mean of B
priorMeanBeta=zeros(M*p,1); %means are equal to zero

% Prior variance of B
priorVarVectors=zeros(M*p,p);

% lag shrinkage
pVector=zeros(p,1);
for j=1:p
    pVector(j)=1/(j^2);
end

varsH=reshape(varsH,M,1);

for i=1:M
    % scale by variance estimates
    vector_iTemp=(varsH(i)*ones(M,1))./varsH;
    vector_iTemp=vector_iTemp*lambda*theta;
    vector_iTemp(i)=vector_iTemp(i)/theta;

    % calculate the prior variances
    vector_i=kron(pVector,vector_iTemp);
    priorVarVectors(:,i)=vector_i;
end

%% Now sample B row-by-row
Ainv=A\eye(M);

Y_Psi=yData-Psi;
Y_Psi(1:p,:)=yData(1:p,:)-ones(p,1)*mean(yData(1:p,:));
X_Psi = lagmatrix(Y_Psi,1:p);
X_Psi = X_Psi(p+1:end,:);
Y_Psi=Y_Psi(p+1:end,:);

OK=0; % to control for unstable draws

rejections=0;
statOK=1;
% start drawing B
while OK==0

    % initialize
    scaledEpsilon=zeros(Tp,M);
    Bdraw=zeros(p*M,M);

    % prepare data for column 1
    y1=Y_Psi(:,1);
    y1Scaled=y1./(SV_H(p+1:T,1).^0.5);
    hScaling1=(SV_H(p+1:T,1).^0.5)*ones(1,p*M);
    X1Scaled=X_Psi./hScaling1;

    % calculate posterior distribution
    postVarBinv=diag(priorVarVectors(:,1).^(-1))+X1Scaled'*X1Scaled;
    postVarB=postVarBinv\eye(M*p);
    postMeanB=postVarB*(diag(priorVarVectors(:,1).^(-1))*priorMeanBeta+X1Scaled'*y1Scaled);

    % obtain cholvar
    [cholPostVarBi,testPD]=chol(postVarB);
    if testPD>0
        cholPostVarBi= cholred(postVarB);
        disp('NPD!')
    end
    cholPostVarBi=cholPostVarBi'; % transpose to obtain lower triangular matrix

    % sample the column of Bdraw
    Bi_draw=postMeanB+cholPostVarBi*randn(p*M,1);
    Bdraw(:,1)=Bi_draw;

    % prepare residuals
    resids_1=y1Scaled-X1Scaled*Bi_draw;
    scaledEpsilon(:,1)=resids_1;

    for i=2:M

        % prepare data for column i
        a_vector=Ainv(i,:)';
        yi=Y_Psi(:,i)-scaledEpsilon*a_vector;
        yiScaled=yi./(SV_H(p+1:T,i).^0.5);

        hScaling_i=(SV_H(p+1:T,i).^0.5)*ones(1,p*M);
        XiScaled=X_Psi./hScaling_i;

        % calculate posterior distribution
        postVarBinv=diag(priorVarVectors(:,i).^(-1))+XiScaled'*XiScaled;
        postVarB=postVarBinv\eye(M*p);
        postMeanB=postVarB*(diag(priorVarVectors(:,i).^(-1))*priorMeanBeta+XiScaled'*yiScaled);

        % obtain cholvar
        [cholPostVarBi,testPD]=chol(postVarB);
        if testPD>0
            cholPostVarBi= cholred(postVarB);
            disp('NPD!')
        end
        cholPostVarBi=cholPostVarBi'; % transpose to obtain lower triangular matrix

        % sample the column of Bdraw
        Bi_draw=postMeanB+cholPostVarBi*randn(p*M,1);
        Bdraw(:,i)=Bi_draw;

        % prepare residuals
        resids_i=yiScaled-XiScaled*Bi_draw;
        scaledEpsilon(:,i)=resids_i;
    end

    % check stability
    [ max_vTemp ] = determineEV(Bdraw,M,p);
    max_v=abs(max_vTemp);

    if max_v <0.999
        OK=1; % accept the draw
    else
        rejections=rejections+1;
        %disp([max_v rejections])
        if rejections>1000
%             disp('Redo This round')
            statOK=0;
            OK=1;
        end

    end

end

end


%% Axes and Antipodal Symmetry
%
%% Directions vs. Axes
%
% In MTEX it is possible to consider three dimensional vectors either as
% directions or as axes. The key option to distinguish between both
% interpretations is *antipodal*.
%
% Consider a pair of vectors

v1 = vector3d(1,1,2);
v2 = vector3d(1,1,-2);

%%
% and plots them in a spherical projection

plot([v1,v2],'label',{'v_1','v_2'})

%%
% These vectors will appear either on the upper or on the lower hemisphere.
% In order to treat these vectors as axes, i.e. in order to assume
% antipodal symmetry - one has to use the keyword *antipodal*.

plot([v1,v2],'label',{'v_1','v_2'},'antipodal')

%%
% Now the direction *v_2* is identified with the direction *-v_2* which
% plots at the upper hemisphere.

%% The Angle between Directions and Axes
%
% As a consequence the angle between two axes *v1*, *v2* will always be the
% smallest angle between the directions *v1*, *v2* and *v1*, *-v2*, i.e. it
% will always be smaller than 90 degree. In the absence of antipodal
% symmetry we obtain

angle(v1,v2) / degree

%%
% whereas, if antipodal symmetry is assumed we obtain

angle(v1,v2,'antipodal') / degree

%% Antipodal Symmetry in Density Estimation
%
% Another example, where antipodal symmetry matters is
% <VectorsDensityEstimation.html density estimation>. For ordinary
% directions we obtain an arbitrary spherical function

v = vector3d.rand(100)
density = v.calcDensity;
plot(density)

%%
% Whereas, if antipodal symmetry is present the resulting density function
% will have antipodal symmetry as well

density = v.calcDensity('antipodal')
plot(density,'complete')

%% Antipodal Symmetry in Experimental Pole Figures
%
% Due to Friedel's law experimental pole figures always provide antipodal
% symmetry. One consequence of this fact is that MTEX plots pole figure
% data always on the upper hemisphere. Moreover if you annotate a certain
% direction to pole figure data, it is always interpreted as an axis, i.e.
% projected to the upper hemisphere if necessary

mtexdata dubna
CS = pf.CS;

% plot the first pole figure
plot(pf({1}))

% annotate a axis on the souther hemisphere
annotate(vector3d(1,0,-1),'labeled','backgroundColor','w')

%% Antipodal Symmetry in Recalculated Pole Figures
%
% However, in the case of pole figures calculated from an ODF antipodal
% symmetry is in general not present.

% some prefered orientation
o = orientation.byEuler(20*degree,30*degree,0,'ZYZ',CS);

% define an unimodal ODF
odf = unimodalODF(o);

% plot pole figures
plotPDF(odf,[Miller(1,2,2,CS),-Miller(1,2,2,CS)])

%%
% Hence, if one wants to compare calculated pole figures with experimental
% ones, one has to add antipodal symmetry.

plotPDF(odf,Miller(1,2,2,CS),'antipodal')

%% Antipodal Symmetry in Inverse Pole Figures
%
% The same reasoning as above holds true for inverse pole figures. If we
% look at complete, inverse pole figures they do not posses antipodal symmetry
% in general

plotIPDF(odf,[yvector,-yvector],'complete')

%%
% However, if we add the keyword antipodal, antipodal symmetry is enforced.

plotIPDF(odf,yvector,'antipodal','complete')

%%
% Notice how MTEX, automatically reduces the fundamental region of inverse
% pole figures in the case that antipodal symmetry is present.

plotIPDF(odf,yvector)

%%
plotIPDF(odf,yvector,'antipodal')


function  [C] =  TWSC_ADMM( Y, D, S, W1, W2, Par )
% This routine solves the following trilateral weighted sparse coding problem
%
% min_{C,Z} |W1(Y-DSC)W2|_F,2 + |Z|_1 s.t.  C=Z
%
% inputs:
%        Y -- d*M data matrix, d is the data dimension, and M is the number
%             of image patches.
%        W1 -- d*d matrix of row weights
%        W2 -- M*M matrix of column weights
% outputs:
%        C -- d*M data matrix, sparse coding coefficient matrix
%        Z -- d*M data matrix, auxiliary variable, equal to C

tol = 1e-8;
Par.maxrho = 100;
Par.maxIter = 10;
Par.rho = 0.5;
Par.mu = 1.1;
Par.display = 0;
% Initializing optimization variables
C = zeros(size(S, 1), size(Y, 2));
Z = zeros(size(C));
U = zeros(size(C));
% Start main loop
iter = 0;
stopCZ = zeros(Par.maxIter, 1);
stopC = zeros(Par.maxIter, 1);
stopZ = zeros(Par.maxIter, 1);
while iter < Par.maxIter
    iter = iter + 1;
    Cpre = C;
    Zpre = Z;
    %% update C, fix Z and U
    % min_{C} ||W1 * (Y - DSC) * W2||_F^2 + 0.5 * rho * ||C - Z + 1/rho * U||_F^2
    % The solution is equal to solve A * X + X * B = E
    A = S' * D' * diag(W1.^2) * D * S;
    W2inv = diag(1./(W2.^2));
    B = 0.5 * Par.rho * W2inv;
    E = S' * D' * diag(W1.^2) * Y + 0.5 * (Par.rho * Z - U) * W2inv;
    C = sylvester(A, B, E);

    %     %% faster solution
    %     [Ua, Sa, ~] = svd(A);
    %     I1 = eye(size(A, 2));
    %     I2 = eye(size(B, 1));
    %     K = kron(I1, A) + kron(B', I2);
    %     invK = 1./diag(K);
    %     UTE = Ua'*E;
    %     vecUTE = UTE(:);
    %     vecUTC = invK .* vecUTE;
    %     MatvecUTC = reshape(vecUTC, [size(UTE, 1) size(UTE, 2)]);
    %     C = Ua*MatvecUTC;

    %% update Z, fix X and D
    % min_{Z} 0.5 * rho * ||Z - (C + 1/rho * U)||_F^2 + ||Z||_1
    Temp = C + U/Par.rho;
    Z = sign(Temp) .* max( abs(Temp) - 1/Par.rho, 0 );

    %% check the convergence conditions
    stopCZ(iter) = max(max(abs(C - Z)));
    stopC(iter) = max(max(abs(C - Cpre)));
    stopZ(iter) = max(max(abs(Z - Zpre)));
    if Par.display %&& (iter==1 || mod(iter,10)==0 || stopC<tol)
        disp(['iter ' num2str(iter) ', mu=' num2str(Par.mu,'%2.1e') ...
            ', max(||c-z||)=' num2str(stopCZ(iter),'%2.3e') ...
            ', max(||c-cpre||)=' num2str(stopC(iter),'%2.3e') ...
            ', max(||z-zpre||)=' num2str(stopZ(iter),'%2.3e')]);
    end
    if stopCZ(iter) < tol && stopC(iter) < tol && stopZ(iter) < tol
        break;
    else
        %% update the augmented multiplier D, fix Z and X
        U = U + Par.rho * (C - Z);
        Par.rho = min(Par.maxrho, Par.mu * Par.rho);
    end
end
return;


% book : Signals and Systems Laboratory with MATLAB
% authors : Alex Palamides & Anastasia Veloni

%Fourier Transfrom properties

%	Time shifting

%x(t)=cos(t)
syms t w
x=cos(t);
t0=2;
xt0=cos(t-t0);
Left=fourier(xt0,w)
X=fourier(x,w);

Right=exp(-j*w*t0)*X


function [HR, HRS, HlR, HlRS, HiR, HiRS, ChiR, HshR, HshRS] = gaussian_method_v7_1_0(R, pars)
%GAUSSIAN_METHOD_V7_1_0 Estimate entropy values using the Gaussian Method.
%
% ---------
% ARGUMENTS
% ---------
% R    - response matrix
% pars - parameters structure

%   Copyright (C) 2009 Cesare Magri
%   Version 7.1.0

% -------
% LICENSE
% -------
% This software is distributed free under the condition that:
%
% 1. it shall not be incorporated in software that is subsequently sold;
%
% 2. the authorship of the software shall be acknowledged and the following
%    article shall be properly cited in any publication that uses results
%    generated by the software:
%
%      Magri C, Whittingstall K, Singh V, Logothetis NK, Panzeri S: A
%      toolbox for the fast information analysis of multiple-site LFP, EEG
%      and spike train recordings. BMC Neuroscience 2009 10(1):81;
%
% 3.  this notice shall remain in place in each source file.

persistent previous_Nt previous_mask;

% HiR, HiRS and ChiR are not computed for the gaussian case, null values
% are returned instead:
HiR  = NaN;
HiRS = NaN;
ChiR = NaN;

% We have to recompute Nc, Nt, maxNt (in the case this routine is called by
% quadratic extrapolation)
Nt    = pars.Nt;
Nc    = size(R,1);
maxNt = size(R,2);
totNt = sum(Nt);
Ns    = pars.Ns;

logOf2times2 = 2*log(2);
logOf2piTimesExp1 = log(2*pi*exp(1));

if ~isequal(previous_Nt, Nt)
  mask = build_logical_mask(Nt, maxNt, Ns);
else
	mask = previous_mask;
end
R(:,~mask) = nan;

% H(R) and H_lin(R) -------------------------------------------------------
if pars.doHR || pars.doHlR

    % Removing mean:
    %meanRvec = mean(R(:,mask),2);
		meanRvec = (sum(sum(R,3),2)+maxNt*Ns-totNt)./totNt; %JM: this is faster, some juggling is needed to account for the -1's

	  %Rvec = R(:,mask) - meanRvec(:,ones(totNt,1));
    Rvec = R(:,mask) - meanRvec*ones(1,totNt);

    covPr = (Rvec * Rvec') ./ (totNt-1);
end

% H(R)
if pars.doHR
    HR = (Nc * logOf2piTimesExp1 + log(det(covPr))) / logOf2times2;

    % Bias correction:
    if pars.biasCorrNum==3
        HRbias = gaussian_bias(totNt, Nc);
        HR = HR - HRbias;
    end
else
    HR = 0;
end

% H_lin(R)
if pars.doHlR
    HlR = (Nc * logOf2piTimesExp1 + sum(log(diag(covPr)), 1)) / logOf2times2;

    % Bias correction:
    if pars.biasCorrNum==3
        HlRbias = Nc * gaussian_bias(totNt, 1);
        HlR = HlR - HlRbias;
    end
else
    HlR = 0;
end

% H(R|S) and H_lin(R|S) ---------------------------------------------------
if pars.doHRS || pars.doHlRS

    % Removing mean
    meanR = sum(R.*permute(mask(:,:,ones(Nc,1)), [3 1 2]), 2) ./ permute(Nt(:, ones(Nc,1)), [2 3 1]);
    Rzeromean = R - meanR(:, ones(maxNt,1), :);

    if Nc==1
        % HlRS is never computed for Nc==1, if we got here it's cause we
        % need to compute H(R|S):

				%covPrsMat = covPrsForSingletonNc(Rzeromean, Nt, mask, maxNt, Ns);
        covPrsMat = reshape(nansum(Rzeromean.*Rzeromean,2),1,[])./(Nt'-1); %JM:

        HRS  = (Nc * logOf2piTimesExp1 + log(covPrsMat(:))) / logOf2times2;

        HlRS = 0;

        % Bias correction:
        if pars.biasCorrNum==3
            HRSbias = gaussian_bias(Nt, 1);
            HRS = HRS - HRSbias;
        end
    else
        HRS  = zeros(Ns,1);
        HlRS = zeros(Ns,1);

        for s=1:Ns
            covPrs = Rzeromean(:, 1:Nt(s), s) * Rzeromean(:, 1:Nt(s), s).' ./ (Nt(s)-1);

            if pars.doHRS
                detCovPrs = det(covPrs);

                HRS(s) = (Nc * logOf2piTimesExp1 + log(detCovPrs)) / logOf2times2;

                % Bias correction:
                if pars.biasCorrNum==3
                    HRSbias = gaussian_bias(Nt(s), Nc);
                    HRS(s) = HRS(s) - HRSbias;
                end
            end;

            if pars.doHlRS
                diagCovPrs = diag(covPrs);

                HlRS(s) = (length(diagCovPrs) * logOf2piTimesExp1 + sum(log(diagCovPrs))) / logOf2times2;

                % Bias correction:
                if pars.biasCorrNum==3
                    HlRSbias = Nc * gaussian_bias(Nt(s), 1);
                    HlRS(s) = HlRS(s) - HlRSbias;
                end
            end
        end
    end

    if ~pars.doHRS
        HRS = 0;
    end

    if ~pars.doHlRS
        HlRS = 0;
    end

else
    HRS  = 0;
    HlRS = 0;
end

% H_sh(R) and H_sh(R|S) ---------------------------------------------------
if pars.doHshR || pars.doHshRS

    Rsh = shuffle_R_across_cells(R, Nt);

    if pars.doHshR
        % Removing mean:
        meanRshvec = mean(Rsh(:,mask),2);
        Rshvec = Rsh(:,mask) - meanRshvec(:,ones(totNt,1));

        covPshr = (Rshvec * Rshvec') ./ (totNt-1);

        HshR = (Nc * logOf2piTimesExp1 + log(det(covPshr))) / logOf2times2;

        % Bias correction:
        if pars.biasCorrNum==3
            HshRbias = gaussian_bias(totNt, Nc);
            HshR = HshR - HshRbias;
        end
    else
        HshR = 0;
    end

    % Remark: HshRS not computed for Nc==1
    if pars.doHshRS
        % Removing mean
        meanRsh = sum(Rsh.*permute(mask(:,:,ones(Nc,1)), [3 1 2]), 2) ./ permute(Nt(:, ones(Nc,1)), [2 3 1]);
        Rsh = Rsh - meanRsh(:,ones(maxNt,1),:);

        HshRS = zeros(Ns,1);
        for s=1:Ns
            covPshrs = Rsh(:, 1:Nt(s), s) * Rsh(:, 1:Nt(s), s).' ./ (Nt(s)-1);
            detCovPshrs = det(covPshrs);

            HshRS(s) = (Nc * logOf2piTimesExp1 + log(detCovPshrs)) / logOf2times2;
        end

        % Bias correction:
        if pars.biasCorrNum==3
            HshRSbias = gaussian_bias(Nt(:), Nc);
            HshRS = HshRS - HshRSbias;
        end
    else
        HshRS = 0;
    end

else
    HshR  = 0;
    HshRS = 0;
end

previous_Nt   = Nt;
previous_mask = mask;

function covPrs = covPrsForSingletonNc(R, Nt, mask, maxNt, Ns)

% Removing first singleton dimension:
R2D = zeros(maxNt, Ns);
R2D(mask) = R(1,mask);

% Computing the variance (R.*R faster than R.^2):
covPrs = (sum(R2D.*R2D,1)) ./ (Nt.' - 1);


function [H,L,Zf1,Zf0] = nciab(x,BL)
% NCIAB(X) takes data in vector x, filters it with half-band allpass
% filter derived from 5th-order Butterworth filter (ref. Mitra P10.40)
% and returns sub-band coefficients for high-pass channel H and low-pass
% channel L.  BL is buffer length to frame data to transmit final all-
% pass filter conditions.  Zf1 and Zf0 are final condition vectors from
% outputs of analysis filters.
%
% Evan Ruzanski, 4/25/2003

% Set params
M = 2; % DS factor

% Prepare input data
while mod(length(x),2*BL) ~= 0 % Make input even length
    x = [x 0];
end

% Filters (5th order Butterworth per Problem 10.40 Mitra (2e))
numa0 = [0.1056 1];
dena0 = [1 0.1056];

numa1 = [0.5278 1];
dena1 = [1 0.5278];

% Create signals (ref. Fig. 10.55 Mitra (2e))
x0 = [x];
x1 = [x];

% Downsample x0
v0 = x0(1:M:length(x0));

% Downsample x1
v1 = x1(2:M:length(x1)); % Delay = 1

% Filter each channel
lenv = length(v0);
count = lenv/BL;
pointer = 1;
win = [pointer:pointer + BL - 1]; % Window frames of data

bcf = 1; % Init buffer switches
bcb = 4;

while count > 0
    buf0(bcf,1:BL) = v0(win); % Use recursive double buffers
    buf1(bcf,1:BL) = v1(win);

    [u01,Zf0(1,count)] = filter(numa0,dena0,buf0(bcf,1:BL));
    [u11,Zf1(1,count)] = filter(numa1,dena1,buf1(bcf,1:BL));

    buf0(bcb,1:BL) = u01;
    buf1(bcb,1:BL) = u11;

    u0p(win) = buf0(bcb,1:BL);
    u1p(win) = buf1(bcb,1:BL);

    bcf = mod(bcf+2,2)+1; % Switch input buffer
    bcb = mod(bcb+2,2)+3; % Switch output buffer
    pointer = pointer + BL;
    win = [pointer:pointer + BL - 1]; % Slide window
    count = count - 1;
end

% Create/tx band coefficients
L = u0p + u1p;
H = u0p - u1p;