% Isoparametric Formulation Implementation
% clear memory
clear all
close all
clc
% E: modulus of elasticity
% A: area of cross section
% L: length of bar
E=8; L=4;
u_exact=@(x) (56-8*(x-2)-24*heaviside(x-5))/2/x;
hold on;
ezplot(u_exact,[2 6])
title('Exact Solution v.s. FEM','interpreter','latex');
xlabel('x','interpreter','latex');
ylabel('Axial stress, $\it{\sigma}_{x}$','interpreter','latex','FontSize',12);

for i=1:4   %For NEL = 1, 2, 4, 8
fprintf( '\nNumber of elements:%d\n\n',2^(i-1) );
% numberElements: number of elements
numberElements=2^(i-1);
% numberNodes: number of nodes
numberNodes=2*numberElements+1;
A=zeros(1,numberElements);
% generation of coordinates and connectivities
NNOD=3;
nodeCoordinates=linspace(2,L+2,numberNodes);
%Generate element length vector
for i=1:numberElements
    Le(i)=L/numberElements;
    elementNodes(i,:)=[(i-1)*2+1 (i-1)*2+2 (i-1)*2+3];
    A(i)=(nodeCoordinates(2*i-1)+Le(i)/2)*2;
end
% for structure:
   % displacements: displacement vector
   % force : force vector
   % stiffness: stiffness matrix
force=zeros(numberNodes,1);
stiffness=zeros(numberNodes,numberNodes);
% computation of the system stiffness matrix and force vector
for e=1:numberElements;
  % elementDof: element degrees of freedom (Dof)
  elementDof=elementNodes(e,:) ;
  detJacobian=Le(e)/2;
  invJacobian=1/detJacobian;
  ngp = 3;
  [w,xi]=gauss1d(ngp);
  xc=0.5*(nodeCoordinates(elementDof(1))+nodeCoordinates(elementDof(end)));
  for ip=1:ngp;
      [shape,naturalDerivatives]=shapeFunctionL3(xi(ip));
      B=naturalDerivatives*invJacobian;
      stiffness(elementDof,elementDof)=...
      stiffness(elementDof,elementDof)+ B'*B*w(ip)*detJacobian*E*A(e);
      force(elementDof)=force(elementDof)+...
          8*shape'*detJacobian*w(ip);
  end
  if(nodeCoordinates(elementDof(end))==5)
     x=(5-xc)/detJacobian;
     [s,n]=shapeFunctionL3(x);
     force(elementDof)= force(elementDof)+...
         24*s';
  end
  if(nodeCoordinates(elementDof(1))<5&&...
          nodeCoordinates(elementDof(3))>5)
     x=(5-xc)/detJacobian;
     [s,n]=shapeFunctionL3(x);
     force(elementDof)= force(elementDof)+...
         24*s';
  end
end
% boundary conditions and solution
% prescribed dofs
prescribedDof=[1];
% solution
GDof=numberNodes;
displacements=solution(GDof,prescribedDof,stiffness,force);
% output displacements/reactions
outputDisplacementsReactionsPretty(displacements,stiffness, ...
    numberNodes,prescribedDof,force)
fprintf('Axial stress\n')
fprintf('element\t\taxial stress\n')
%Stress and strain recovery
ngp = 3;
elementNodeCoor=zeros(numberElements*NNOD,1);
elementNodeStr=zeros(numberElements*NNOD,1);
for e=1:numberElements;
  % elementDof: element degrees of freedom (Dof)
  elementDof=elementNodes(e,:);
  detJacobian=Le(e)/2;
  invJacobian=1/detJacobian;
  xi=[-1 0 1];
  for ip=1:NNOD;
      [shape,naturalDerivatives]=shapeFunctionL3(xi(ip));
      B=naturalDerivatives*invJacobian;
      elementNodeCoor(ip+(e-1)*NNOD,1)=nodeCoordinates(elementDof(ip));
      elementNodeStr(ip+(e-1)*NNOD,1)=E*B*displacements(elementDof,1);
      fprintf('%2.0f\t%2.0fth node\t%10.4e\n', e, ip,elementNodeStr(ip+(e-1)*NNOD,1))
  end
end

%post process
switch numberElements
    case 1
        str='r*--';
    case 2
        str='g*--';
    case 4
        str='k*--';
    case 8
        str='m*--';
end

plot(elementNodeCoor,elementNodeStr,str)
hold on;
end
legend('Exact solution','NEL=1','NEL=2','NEL=4','NEL=8','interpreter','latex');


%% Outlier demo
%Copyright (c) 2011, The MathWorks, Inc.

clear all
clc

% Generate a vector of X and Y variables
[CleanX, CleanY] = meshgrid(1:10);
CleanX = reshape(CleanX,100,1);
CleanY = reshape(CleanY,100,1);

%% Specify Z as a function of X and Y
A = 3; B = 4;
CleanZ = A*CleanX + B*CleanY;

%% Add in a noise vector
noise = 2*randn(100,1);
Noisy_Z = CleanZ + noise;

% Plot
scatter3(CleanX, CleanY, Noisy_Z, 'filled')
hold on

%% Predict Z as a function of X and Y
[foo gof] = fit([CleanX, CleanY], Noisy_Z, 'poly11')
plot(foo)

%% Use Robust Regression

bar = fit([CleanX, CleanY], Noisy_Z, 'poly11', 'Robust', 'LAR')

%% Use robustfit

b = robustfit([CleanX, CleanY], Noisy_Z)


function [H A b] = affineLS(X1, X2, normalization)

% [H A b] = affineLS(X1, X2, normalization)
%
% DESC:
% computes the affine transformation between the point pairs X1, X2
%
% VERSION:
% 1.0.0
%
% INPUT:
% X1, X2        = point matches (cartesian coordinates)
% normalization = true (default) or false to enable/disable point
%                 normalzation
%
% OUTPUT:
% H             = homography representing the affine transformation
% A             = 4x4 affine coefficient matrix
% b             = affine translation vector

% AUTHOR:
% Marco Zuliani, email: marco.zuliani@gmail.com
% Copyright (C) 2010 by Marco Zuliani
%
% LICENSE:
% This toolbox is distributed under the terms of the GNU GPL.
% Please refer to the files COPYING.txt for more information.

% HISTORY
% 1.0.0         11/22/10 - intial version

if (nargin < 3)
    normalization = true;
end;

N = size(X1, 2);

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% checks
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if (size(X2, 2) ~= N)
    error('AffineLS:inputError', ...
        'The set of input points should have the same cardinality')
end;
if N < 2
    error('AffineLS:inputError', ...
        'At least 3 point correspondences are needed')
end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% normalize the input
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if normalization
    % fprintf('\nNormalizing...')
    [X1, T1] = normalize_points(X1);
    [X2, T2] = normalize_points(X2);
end;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% estimation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Traditional LS
P = zeros(2*N, 6);
q = zeros(2*N, 1);

ind = 1:2;
for n = 1:N

    P(ind, :) = [X1(1,n) 0 X1(2,n) 0 1 0; 0 X1(1,n) 0 X1(2,n) 0 1];

    q(ind) = X2(1:2, n);

    ind = ind + 2;

end;

% solve the linear system in a least square sense
Theta = P\q;

% compute the corresponding homography
H = [Theta(1) Theta(3) Theta(5); Theta(2) Theta(4) Theta(6); 0 0 1];

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% de-normalize the parameters
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
if normalization
    H = T2\H*T1;
end;
H = H/H(9);

% prepare the output
if nargout > 1

    A = H(1:2, 1:2);
    b = H(1:2, 3);

end;

return


function centroid = triangle_centroid_3d ( t )

%*****************************************************************************80
%
%% TRIANGLE_CENTROID_3D computes the centroid of a triangle in 3D.
%
%  Discussion:
%
%    The centroid of a triangle can also be considered the
%    center of gravity or center of mass, assuming that the triangle
%    is made of a thin uniform sheet of massy material.
%
%    The centroid of a triangle is the intersection of the medians.
%    A median of a triangle is a line connecting any vertex to the
%    midpoint of the opposite side.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 January 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real T(3,3), the triangle vertices.
%
%    Output, real CENTROID(3,1), the coordinates of the centroid.
%
  dim_num = 3;

  for i = 1 : dim_num
    centroid(i,1) = sum ( t(i,1:3) ) / 3.0;
  end

  return
end


function pass = test_ellipjODE(pref)
% Test to check that the chebfun command for Jacobi elliptic functions
% ELLIPJ produces a similar result to the solution of the nonlinear
% differential equation that generates it.

% NOTE: Taken from V4 test chebop_ellipjode.

if ( nargin == 0 )
    pref = cheboppref();
end
tol = 1e-10;

% Elliptic parameter
m = .1;
K = ellipke(m);
d = [0, K];
x = chebfun(@(x) x, d);

%% jacobi elliptic functions
[sn, cn, dn] = ellipj(x, m);

% SN is the solution of an ODE
N = chebop(d);
N.op = @(x,u) diff(u,2) + (1+m)*u - 2*m*u.^3;
N.lbc = @(u) u;% The solution here is close to being singular, and we only enjoy linear convergence  so loosen the tolerance
N.rbc = @(u) u - 1 ;
u = N\0;
err(1) = norm(u - sn, inf);

%% CN
N.op = @(x, u) diff(u, 2) + (1-2*m)*u + 2*m*u.^3;
N.lbc = @(u) u - 1 ;
N.rbc = @(u) u ;
u = mldivide(N, 0, pref);
err(2) = norm(u - cn, inf);

% %% DN
% % The solution here is close to being singular, and we only enjoy linear
% % convergence of Newton iteratin. Loosen the tolerance.
% pref.bvpTol = 5e-5;
% N.op = @(x, u) diff(u, 2) - (2-m)*u + 2*u.^3;
% N.lbc = @(u) u - 1 ;
% N.rbc = @(u) u - sqrt(1-m);
% u = mldivide(N, 0, pref);
% err(3) = norm(u - dn, inf);

%%
% pass = err < [tol, tol, 2e6*tol];
pass = err < [tol, tol];

end


function [D,P] = dijk(A,s,t)
%DIJK Shortest paths from nodes 's' to nodes 't' using Dijkstra algorithm.
% [D,p] = dijk(A,s,t)
%     A = n x n node-node weighted adjacency matrix of arc lengths
%         (Note: A(i,j) = 0   => Arc (i,j) does not exist;
%                A(i,j) = NaN => Arc (i,j) exists with 0 weight)
%     s = FROM node indices
%       = [] (default), paths from all nodes
%     t = TO node indices
%       = [] (default), paths to all nodes
%     D = |s| x |t| matrix of shortest path distances from 's' to 't'
%       = [D(i,j)], where D(i,j) = distance from node 'i' to node 'j'
%     P = |s| x n matrix of predecessor indices, where P(i,j) is the
%         index of the predecessor to node 'j' on the path from 's(i)' to 'j'
%         (use PRED2PATH to convert P to paths)
%       = path from 's' to 't', if |s| = |t| = 1
%
%  (If A is a triangular matrix, then computationally intensive node
%   selection step not needed since graph is acyclic (triangularity is a
%   sufficient, but not a necessary, condition for a graph to be acyclic)
%   and A can have non-negative elements)
%
%  (If |s| >> |t|, then DIJK is faster if DIJK(A',t,s) used, where D is now
%   transposed and P now represents successor indices)
%
%  (Based on Fig. 4.6 in Ahuja, Magnanti, and Orlin, Network Flows,
%   Prentice-Hall, 1993, p. 109.)

% Copyright (c) 1998-2001 by Michael G. Kay
% Matlog Version 5 22-Aug-2001

% Input Error Checking ******************************************************
error(nargchk(1,3,nargin));

[n,cA] = size(A);

if nargin < 2 | isempty(s), s = (1:n)'; else s = s(:); end
if nargin < 3 | isempty(t), t = (1:n)'; else t = t(:); end

if ~any(any(tril(A) ~= 0))       % A is upper triangular
   isAcyclic = 1;
elseif ~any(any(triu(A) ~= 0))   % A is lower triangular
   isAcyclic = 2;
else                             % Graph may not be acyclic
   isAcyclic = 0;
end

if n ~= cA
   error('A must be a square matrix');
elseif ~isAcyclic & any(any(A < 0))
   error('A must be non-negative');
elseif any(s < 1 | s > n)
   error(['''s'' must be an integer between 1 and ',num2str(n)]);
elseif any(t < 1 | t > n)
   error(['''t'' must be an integer between 1 and ',num2str(n)]);
end
% End (Input Error Checking) ************************************************

A = A';    % Use transpose to speed-up FIND for sparse A

D = zeros(length(s),length(t));
if nargout > 1, P = zeros(length(s),n); end

for i = 1:length(s)
   j = s(i);

   Di = Inf*ones(n,1); Di(j) = 0;

   isLab = logical(zeros(length(t),1));
   if isAcyclic ==  1
      nLab = j - 1;
   elseif isAcyclic == 2
      nLab = n - j;
   else
      nLab = 0;
      UnLab = 1:n;
      isUnLab = logical(ones(n,1));
   end

   while nLab < n & ~all(isLab)
      if isAcyclic
         Dj = Di(j);
      else	% Node selection
         [Dj,jj] = min(Di(isUnLab));
         j = UnLab(jj);
         UnLab(jj) = [];
         isUnLab(j) = 0;
      end

      nLab = nLab + 1;
      if length(t) < n, isLab = isLab | (j == t); end

      [jA,kA,Aj] = find(A(:,j));
      Aj(isnan(Aj)) = 0;

      if isempty(Aj), Dk = Inf; else Dk = Dj + Aj; end

      if nargout > 1, P(i,jA(Dk < Di(jA))) = j; end
      Di(jA) = min(Di(jA),Dk);

      if isAcyclic == 1       % Increment node index for upper triangular A
         j = j + 1;
      elseif isAcyclic == 2   % Decrement node index for lower triangular A
         j = j - 1;
      end
   end
   D(i,:) = Di(t)';
end

if nargout > 1 & length(s) == 1 & length(t) == 1
   P = pred2path(P,s,t);
end


function varargout = cylinderMesh(cyl, varargin)
%CYLINDERMESH  Create a 3D mesh representing a cylinder
%
%   [V F] = cylinderMesh(CYL)
%   Computes vertex coordinates and face vertex indices of a mesh
%   representing a 3D cylinder given as [X1 Y1 Z1 X2 Y2 Z2 R].
%
%   Example
%     % Draw a rotated cylinder
%     cyl = [0 0 0 10 20 30 5];
%     [v f] = cylinderMesh(cyl);
%     figure;drawMesh(v, f, 'FaceColor', 'r');
%     view(3); axis equal;
%
%     % Draw three mutually intersecting cylinders
%       p0 = [30 30 30];
%       p1 = [90 30 30];
%       p2 = [30 90 30];
%       p3 = [30 30 90];
%       [v1 f1] = cylinderMesh([p0 p1 25]);
%       [v2 f2] = cylinderMesh([p0 p2 25]);
%       [v3 f3] = cylinderMesh([p0 p3 25]);
%       figure; hold on;
%       drawMesh(v1, f1, 'FaceColor', 'r');
%       drawMesh(v2, f2, 'FaceColor', 'g');
%       drawMesh(v3, f3, 'FaceColor', 'b');
%       view(3); axis equal
%       set(gcf, 'renderer', 'opengl')
%
%   See also
%     drawCylinder, torusMesh, sphereMesh

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

% extract cylinder data
p1 = cyl(:, 1:3);
p2 = cyl(:, 4:6);
r  = cyl(:, 7);

% compute length and orientation
[theta, phi, rho] = cart2sph2d(p2 - p1);

% parametrisation on x
t = linspace(0, 2*pi, 20);
lx = r * cos(t);
ly = r * sin(t);

% parametrisation on z
lz = linspace(0, rho, 10);

% generate surface grids
x = repmat(lx, [length(lz) 1]);
y = repmat(ly, [length(lz) 1]);
z = repmat(lz', [1 length(t)]);

% transform points
trans   = localToGlobal3d(p1, theta, phi, 0);
[x, y, z] = transformPoint3d(x, y, z, trans);

% convert to FV mesh
[vertices, faces] = surfToMesh(x, y, z, 'xPeriodic', true);

% format output
varargout = formatMeshOutput(nargout, vertices, faces);


function [ area, radout, side ] = polygon_inrad_data_2d ( n, radin )

%*****************************************************************************80
%
%% POLYGON_INRAD_DATA_2D determines polygonal data from its inner radius in 2D.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    24 February 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the number of sides of the polygon.
%    N must be at least 3.
%
%    Input, real RADIN, the inner radius of the polygon, that is,
%    the radius of the largest circle that can be inscribed within
%    the polygon.
%
%    Output, real AREA, the area of the regular polygon.
%
%    Output, real RADOUT, the outer radius of the polygon, that is,
%    the radius of the smallest circle that can be described about
%    the polygon.
%
%    Output, real SIDE, the length of one side of the polygon.
%
  if ( n < 3 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'POLYGON_INRAD_DATA_2D - Fatal error!\n' );
    fprintf ( 1, '  Input value of N must be at least 3\n' );
    fprintf ( 1, '  but your input value was N = %d\n', n );
    error ( 'POLYGON_INRAD_DATA_2D - Fatal error!' );
  end

  angle = pi / n;
  area = n * radin * radin * tan ( angle );
  side = 2.0 * radin * tan ( angle );
  radout = 0.5 * side / sin ( angle );

  return
end


function value = i4_bit_lo1 ( n )

%*****************************************************************************80
%
%% I4_BIT_LO1 returns the position of the low 1 bit base 2 in an integer.
%
%  Example:
%
%       N    Binary    Lo 1
%    ----    --------  ----
%       0           0     0
%       1           1     1
%       2          10     2
%       3          11     1
%       4         100     3
%       5         101     1
%       6         110     2
%       7         111     1
%       8        1000     4
%       9        1001     1
%      10        1010     2
%      11        1011     1
%      12        1100     3
%      13        1101     1
%      14        1110     2
%      15        1111     1
%      16       10000     5
%      17       10001     1
%    1023  1111111111     1
%    1024 10000000000    11
%    1025 10000000001     1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 November 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer N, the integer to be measured.
%    N should be nonnegative.
%
%    Output, integer I4_BIT_LO1, the position of the low 1 bit.
%
  bit = 0;
  i = n;

  while ( 1 )

    bit = bit + 1;
    i2 = floor ( i / 2 );

    if ( i ~= 2 * i2 )
      break
    end

    i = i2;

  end

  value = bit;

  return
end


function jacobi_eigenvalue_test03 ( )

%*****************************************************************************80
%
%% JACOBI_EIGENVALUE_TEST03 uses a 5x5 test matrix.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 July 2013
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'JACOBI_EIGENVALUE_TEST03\n' );
  fprintf ( 1, '  For a symmetric matrix A,\n' );
  fprintf ( 1, '  JACOBI_EIGENVALUE computes the eigenvalues D\n' );
  fprintf ( 1, '  and eigenvectors V so that A * V = D * V.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Use the discretized second derivative matrix.\n' );

  n = 5;

  a = zeros ( n, n );
  for i = 1 : n
    a(i,i) = -2.0;
  end
  for i = 1 : n - 1
    a(i,i+1) = +1.0;
    a(i+1,i) = +1.0;
  end

  r8mat_print ( n, n, a, '  Input matrix A:' );

  it_max = 100;

  [ v, d, it_num, rot_num ] = jacobi_eigenvalue ( n, a, it_max );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of iterations = %d\n', it_num );
  fprintf ( 1, '  Number of rotations  = %d\n', rot_num );

  r8vec_print ( n, d, '  Eigenvalues D:' );

  r8mat_print ( n, n, v, '  Eigenvector matrix V:' );
%
%  Compute eigentest.
%
  error_frobenius = r8mat_is_eigen_right ( n, n, a, v, d );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Frobenius norm error in eigensystem A*V-D*V = %g\n', ...
    error_frobenius );

  return
end


function out = proj_l1ball_box(x,w,r,u)
%PROJ_L1BALL_BOX computes the orthogonal projection onto the intersection of an l1 ball and a box
%                                                  {x: norm(w(:).*x(:),1)<=r, -u<=x<=u}
%
%  Usage:
%  out = PROJ_L1BALL_BOX(x,[w],[r],[u])
%  =============================================================
%  INPUT:
%  x - point to be projected (vector/matrix)
%  w - weights vecotr - [default: 1]
%  r - positive scalar - [default: 1]
%  u - box paramters (scalar/vector/matrix)- [default: Inf]
%  ==============================================================
%  Assumptions:
%  r,u >= 0
%  w >= 0
%  ==============================================================
%  Output:
%  out - projection vector

% This file is part of the FOM package - a collection of first order methods for solving convex optimization problems
% Copyright (C) 2017 Amir and Nili Beck
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% 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/>.

%reading the user x and setting defalut values when required.
if (nargin < 1)
    error ('usage: proj_l1_inter_box(x,[w],[r],[u])') ;
end

if (nargin < 4)
    %box parameters are not given, setting to defalut value :inf
    u = inf*(ones(size(x))) ;
end

if ((nargin < 3) || (isempty(r)))
    %ball radius is not given, setting to defalut value :1
    r = 1;
end

if ((nargin < 2) || (isempty(w)))
    %weight vector is not given, setting to default value: ones
    w=ones(size(x)) ;
end

if  ((r < 0) || (min(min(u)) < 0))
      error('Set is infeasible') ;
end

if (min(min(w)) < 0)
    error('usage: proj_l1_inter_box(x,[w],[r],[u]) - w should be a non-negative vector or matrix');
end

%checking the simple projection
out = min(max(x,-u),u) ;
if ((sum(sum(w .* abs (out)))) <= r)
    return;
end

%defining f on lambda - to be used by the bisetion

f= @(lam)   trace(w' * abs(min(max(abs(x)-lam*w,0),u) .* sign(x)))- r;
lambda_min = 0;

lambda_max = 1;
while(f(lambda_max)>0)
    lambda_max = lambda_max *2  ;
end

eps = 1e-10 ;
final_lam = bisection(f,lambda_min,lambda_max,eps) ;
out=  min(max(abs(x)-final_lam*w,0),u) .* sign(x) ;


function d = mahalanobis(varargin)
%MAHALANOBIS Computes the Mahalanobis distance.
%   D = MAHALANOBIS(Y, X) computes the Mahalanobis distance between
%   each vector in Y to the mean (centroid) of the vectors in X, and
%   outputs the result in vector D, whose length is size(Y, 1).  The
%   vectors in X and Y are assumed to be organized as rows.  The
%   input data can be real or complex. The outputs are real
%   quantities.
%
%   D = MAHALANOBIS(Y, CX, MX) computes the Mahalanobis distance
%   between each vector in Y and the given mean vector, MX. The
%   results are output in vector D, whose length is size(Y, 1).  The
%   vectors in Y are assumed to be organized as the rows of this
%   array. The input data can be real or complex. The outputs are
%   real quantities. In addition to the mean vector MX, the
%   covariance matrix CX of a population of vectors X also must be
%   provided. Use function COVMATRIX (Section 11.5) to compute MX and
%   CX.

%   Copyright 2002-2004 R. C. Gonzalez, R. E. Woods, & S. L. Eddins
%   Digital Image Processing Using MATLAB, Prentice-Hall, 2004
%   $Revision: 1.6 $  $Date: 2005/01/18 13:44:47 $

% Reference: Acklam, P. J. [2002]. "MATLAB Array Manipulation Tips
% and Tricks." Available at
%     home.online.no/~pjacklam/matlab/doc/mtt/index.html
% or at
%     www.prenhall.com/gonzalezwoodseddins

param = varargin; % Keep in mind that param is a cell array.
Y = param{1};
ny = size(Y, 1); % Number of vectors in Y.

if length(param) == 2
   X = param{2};
   % Compute the mean vector and covariance matrix of the vectors
   % in X.
   [Cx, mx] = covmatrix(X);
elseif length(param) == 3 % Cov. matrix and mean vector provided.
   Cx = param{2};
   mx = param{3};
else
   error('Wrong number of inputs.')
end
mx = mx(:)'; % Make sure that mx is a row vector.

% Subtract the mean vector from each vector in Y.
Yc = Y - mx(ones(ny, 1), :);

% Compute the Mahalanobis distances.
d = real(sum(Yc/Cx.*conj(Yc), 2));


function ncomb = multinomial_coef2 ( nfactor, factor )

%*****************************************************************************80
%
%% MULTINOMIAL_COEF2 computes a Multinomial coefficient.
%
%  Discussion:
%
%    The multinomial coefficient is a generalization of the binomial
%    coefficient.  It may be interpreted as the number of combinations of
%    N objects, where FACTOR(1) objects are indistinguishable of type 1,
%    ... and FACTOR(NFACTOR) are indistinguishable of type NFACTOR,
%    and N is the sum of FACTOR(1) through FACTOR(NFACTOR).
%
%    NCOMB = N! / ( FACTOR(1)! FACTOR(2)! ... FACTOR(NFACTOR)! )
%
%    A direct method is used, which should be exact.  However, there
%    is a possibility of intermediate overflow of the result.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 September 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NFACTOR, the number of factors.
%    1 <= NFACTOR.
%
%    Input, integer FACTOR(NFACTOR), contains the factors.
%    0.0 <= FACTOR(I).
%
%    Output, integer NCOMB, the value of the multinomial coefficient.
%
  ncomb = 1;
  k = 0;

  for i = 1 : nfactor

    for j = 1 : factor(i)
      k = k + 1;
      ncomb = ( ncomb * k ) / j;
    end

  end

  return
end


%% example
function [Y, X, U] = example(U, varargin)

%% Syntax
%  function [Y, X, U] = example(U, varargin)

%% Description
% Function for simulating the nonlinear dynamic system:
%
%                y(k)
%   y(k+1) = ---------------  + [u(k)]^3
%            1 + y(k)*y(k)
%
% which is used to demonstrate the use of this toolbox.
% [1] K.S. Narendra and K. Parthasarathy. Identification
% and Control of Dynamical Systems Using Neural Networks,
% IEEE Transactions on NN, Vol.1 No. 1, 4-27, 1990.
%
% Usage:
% (1) [Y, X, U] = example(u, y0), u is vector, y0 is optional
% (2) [Y, X, U] = example(U, y0), U is Nx2 matrix
% Inputs:
% u .. vector of inputs
% U .. matrix U=[x u], where x is vector of past states nad u is vector of
%   inputs
% y0 .. intial state of the system, optional
% Outputs:
% Y .. vector of outputs
% X .. vector of past outputs: X(k) = Y(k-1)
% U .. vector of inputs
%
%

%% Examples
% demo_example_gp_data.m

%% See Also
% EXAMPLE_DERIVATIVE, EXAMPLE_LM_IDENT

if(nargin==1)
    y0 = 0;
else
    y0 = varargin{1};
end

if (size(U,2)>2 || size(U,2)<1)
    error('input U must have size 1 or 2');
elseif (size(U,2)==2)
    % first coloumn = y
    % second coloumn = u
    X = U(:,1);
    U = U(:,2);
    Y = X./(1+X.^2) + U.^3;
else % size(U,2)=1
    % step1
    X = y0;
    % steps
    for ii=1:length(U)
        Y(ii) = X(ii)/(1+X(ii).^2) + U(ii).^3;
        X(ii+1) = Y(ii);
    end

    X = X(1:end-1);
    X = X'; Y = Y';
end


function f = mckinnon ( x )

%*****************************************************************************80
%
%% MCKINNON computes the McKinnon function.
%
%  Discussion:
%
%    This function has a global minimizer:
%
%      X* = ( 0.0, -0.5 ), F(X*) = -0.25.
%
%    There are three parameters, TAU, THETA and PHI.
%
%    1 < TAU, then F is strictly convex.
%             and F has continuous first derivatives.
%    2 < TAU, then F has continuous second derivatives.
%    3 < TAU, then F has continuous third derivatives.
%
%    However, this function can cause the Nelder-Mead optimization
%    algorithm to "converge" to a point which is not the minimizer
%    of the function F.
%
%    Sample parameter values which cause problems for Nelder-Mead
%    include:
%
%      TAU = 1, THETA = 15, PHI =  10;
%      TAU = 2, THETA =  6, PHI =  60;
%      TAU = 3, THETA =  6, PHI = 400;
%
%    To get the bad behavior, we also assume the initial simplex has the form
%
%      X1 = (0,0),
%      X2 = (1,1),
%      X3 = (A,B),
%
%    where
%
%      A = (1+sqrt(33))/8 =  0.84307...
%      B = (1-sqrt(33))/8 = -0.59307...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 January 2011
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Ken McKinnon,
%    Convergence of the Nelder-Mead simplex method to a nonstationary point,
%    SIAM Journal on Optimization,
%    Volume 9, Number 1, 1998, pages 148-158.
%
%  Parameters:
%
%    Input, real X(2), the argument of the function.
%
%    Output, real F, the value of the function at X.
%
  if ( length ( x ) ~= 2 )
    error ( 'Error: function expects a two dimensional input\n' );
  end

  tau = 2.0;
  theta = 6.0;
  phi = 60.0;

  if ( x(1) <= 0.0 )
    f = theta * phi * abs ( x(1) ).^tau + x(2) * ( 1.0 + x(2) );
  else
    f = theta       *       x(1).^tau   + x(2) * ( 1.0 + x(2) );
  end

  return
end


function g = sigmoidGradient(z)
%SIGMOIDGRADIENT returns the gradient of the sigmoid function
%evaluated at z
%   g = SIGMOIDGRADIENT(z) computes the gradient of the sigmoid function
%   evaluated at z. This should work regardless if z is a matrix or a
%   vector. In particular, if z is a vector or matrix, you should return
%   the gradient for each element.

g = zeros(size(z));

% ====================== YOUR CODE HERE ======================
% Instructions: Compute the gradient of the sigmoid function evaluated at
%               each value of z (z can be a matrix, vector or scalar).

g = sigmoid(z) .* (1-sigmoid(z));

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

end


function[varargout] = vmoment(varargin)
%VMOMENT Central moment over non-NaN elements along a specfied dimension.
%
%   Y=VMOMENT(X,N,DIM) finds the Nth central moment of all non-NaN elements
%   of X along dimension DIM.
%
%   [Y,NUM]=VMOMENT(X,N,DIM) also outputs the number of non-NaN data points
%   NUM, which has the same dimension as X.
%
%   [Y1,Y2,...YN]=VMOMENT(X1,X2,...XN,N,DIM) also works.
%
%   VMOMENT(X1,X2,...XN,N,DIM);  with no output arguments overwrites the
%   original input variables.
%   __________________________________________________________________
%   This is part of JLAB --- type 'help jlab' for more information
%   (C) 2001--2020 J.M. Lilly --- type 'help jlab_license' for details

if strcmpi(varargin{1}, '--t')
  vmoment_test,return
end

n=varargin{end-1};
ndim=varargin{end};

for i=1:length(varargin)-2
  x=varargin{i};
  m=vmean(x,ndim);
  m=vrep(m,size(x,ndim),ndim);

  %previously I had an abs around (x-m), that was incorrect
  [varargout{i},numi{i}]=vmean((x-m).^n,ndim);
end

for i=length(varargin)-1:nargout
  varargout{i}=numi{i-length(varargin)+2};
end

eval(to_overwrite(nargin-2))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function[]=vmoment_test
x1=[1 2 3 nan];
x2=x1;
ans1=2/3;

vmoment(x1,x2,2,2);
reporttest('VMOMENT output overwrite', aresame(x1,ans1) && aresame(x2,ans1))

x1=[1 2 3 nan];
ans2=3;
[y1,y2]=vmoment(x1,2,2);
reporttest('VMOMENT moment & num', aresame(y1,ans1) && aresame(y2,ans2))


function [xi,w]=secondOrderPrismCubPoints()
%%SECONDORDERPRISMCUBPOINTS Generate second-order cubature points for
%  integration over a standard prism in 3D. This is a triangle that has
%  been extruded upward. The vertices are (1,-1,-1), (-1,-1,-1), (-1,1,-1),
%  (1,-1,1), (-1,-1,1), and (-1,1,1).
%
%INPUTS: None
%
%OUTPUTS: xi This is a 3XnumCubPoints set of points for the standard prism.
%          w A 1XnumCubPoints set of cubature weights. This sums to the
%            volume of the standard prism (4).
%
%This function implements the points given in [1] (5 points).
%
%EXAMPLE:
%We compare a 2nd-order moment computed using these cubature points
%to one computed using monomialIntPrism. The results are the same within
%typical finite precision limits.
% [xi,w]=secondOrderPrismCubPoints();
% alpha=[2;0;0];
% theMoment=findMomentFromSamp(alpha,xi,w);
% intVal=monomialIntPrism(alpha);
% RelErr=(theMoment-intVal)/intVal
%
%REFERENCES:
%[1] F. D. Witherden and P. E. Vincent, "On the identification of symmetric
%    quadrature rules for finite element methods," Computer and Mathematics
%    with Applications, vol. 69, no. 10, pp. 1232-1241, May 2015.
%
%October 2022 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

M=[-0.33333333333333333333333333333333333333,  -0.33333333333333333333333333333333333333,  -0.99999999999999985119303811076522004183,   0.66666666666666686507594918564641756458;
-0.33333333333333333333333333333333333333,  -0.33333333333333333333333333333333333333,   0.99999999999999985119303811076522004183,   0.66666666666666686507594918564641756458;
-0.74158162379719638007464124598498266439,   0.48316324759439276014928249196996532878,                                          0,   0.88888888888888875661603387623572162361;
 0.48316324759439276014928249196996532878,  -0.74158162379719638007464124598498266439,                                          0,   0.88888888888888875661603387623572162361;
-0.74158162379719638007464124598498266439,  -0.74158162379719638007464124598498266439,                                          0,   0.88888888888888875661603387623572162361];

w=M(:,4);
xi=M(:,1:3)';

end

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


function variance = f_variance ( m, n )

%*****************************************************************************80
%
%% F_VARIANCE returns the variance of the F central PDF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 October 2004
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the parameters of the PDF.
%    1 <= M,
%    1 <= N.
%    Note, however, that the variance is not defined unless 5 <= N.
%
%    Output, real VARIANCE, the variance of the PDF.
%
  if ( n < 5 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'F_VARIANCE - Fatal error!\n' );
    fprintf ( 1, '  The variance is not defined for N < 5.\n' );
    error ( 'F_VARIANCE - Fatal error!' );
  end

  variance = 2 * n * n * ( m + n - 2 ) / ( m * ( n - 2 )^2 * ( n - 4 ) );

  return
end


function [P,varargout] = laplace(xs,A,b,AEq,bEq,varargin)
% LAPLACE Smooth compact 1,2 or 3 dimensional atomic probability distribution subject to linear and moment constraints
%
% LAPLACE('demo') or LAPLACE() runs univariate, bivariate and trivariate examples
%
% P = LAPLACE({xs1,xs2},[],[],[],[],[mu1 mu2],[mu11,mu12,mu22]) returns an
% matrix of size length(xs1) x length(xs2). The value P(i,j) is interpreted
% as a probability assigned to lattice point (xs1(i), xs2(j)). This 2d atomic
% probability minimizes the square of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints E[x1]=mu1, E[x2]=mu2,
% E[x1.*x2] = mu11, E[x1.*x2]=mu12, E[x2.*x2]=mu22 where E denotes the expectation
% operator E(f) = sum(sum(f.*P)) and x1,x2,x3 are arrays of n-d coordinates
% function generated by [x1,x2,x3] = ndgrid(xs{:}).
%
% P = LAPLACE({xs1,xs2},A,b,AEq,bEq) returns a matrix of size length(xs1) x length(xs2).
% The value P(i,j) is interpreted as a probability assigned to lattice point (xs1(i), xs2(j)).
% The 2-d atomic probability minimizes the square of the discrete laplacian subject to inequality
% constraint A*P(:) < b and/or equality constraint AEq*P(:) = bEq. Supplied vectors
% b and bEq should be of length length(xs1) x length(xs2). A,b, AEq and bEq
% may be empty. In particular ...
%
% P = LAPLACE(xs1,[],[],[f1;f2;...],[Ef1;Ef2;...]) where f1,f2,... are row vectors
% of size 1 x length(xs1) representing functions on grid points xs1, and Ef1, Ef2
% are scalars representing their means returns a smooth compact probability
% distribution with E[f1] = Ef1, E[f2] = Ef2 and so forth.
%
% P = LAPLACE(xs1,[],[],[],[],mu1,mu11,mu111,mu1111) returns a
% vector of size length(xs1) x 1. The element P(i) is interpreted
% as a probability assigned to lattice point xs1(i). The 1-d atomic
% probability minimizes the square of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints E[x1]=mu1,
% E[x1.*x1]=mu11, E[x1.*x1.*x1] = mu111 and E[x1.*x1.*x1.*x1]=mu1111.
% Addtional moment constraints may be supplied.
%
% P = LAPLACE({xs1,xs2,xs3},[],[],[],[],varargin) returns an
% matrix of size length(xs1) x length(xs2) x length(xs3). The value P(i,j,k) is interpreted
% as a probability assigned to lattice point (xs1(i), xs2(j), xs3(j)). The 3d atomic
% probability minimizes the sums squares of projections of the discrete laplacian assuming zero
% boundary condition, subject to moment constraints contained in varargin.
% Each constraint should be a vector of length NCHOOSEK(K+2,2) and contain
% moment values (as defined above) for all polynomials in x1, x2 and x3 of
% degree k sorted by reverse lexicographic ordering of their coefficients.
% For example, P = LAPLACE({xs1,xs2,xs3},[],[],[],[],[mu11,mu12,mu13,mu22,mu23,mu33])
% minimizes E[x1.^2] = mu11, E[x1.x2]= mu12 and so forth. The degree of the
% implied polynomials is inferred from the length of the moment vector.
%
% P = LAPLACE(...,A,b,AEq,bEq,...) applies additional user supplied
% inequality and equality constraints on P(:), as per the convention in
% most optimization functions including QUADPROG
%
%
% ARGUMENTS:
%   xs      n x 1 cell array  of vectors  - Lattice points at which the probability distribution is supported (compatible with ndgrid(xs{:}))
%   A,b,AEq,bEq                           - Inequality and equality constraints (can be empty), as per QUADPROG
%   varargin                              - Listing of desired values for moments (see explanation below)
%   P       m1 x m2 x ... x mn            - Lattice point probabilities (n-dimensional)
%   varargout                             - Evaluation of moments inferred by P in the same order as they are supplied
%
% MOMENT CONSTRAINTS:
%   If varargin{i} has length nchoosek(k+n-1,n-1) is it intepreted as a set of moment
%   constraints on polynomials of degreee k in the n coordinate functions, listed by
%   reverse lexicographic ordering. [A shortcoming of this convention is
%   that *all* degree k moments must be supplied].
%
%           if n=2 then [0.1 0.3] means E[x1]=0.1 and E[x2]=0.3
%           if n=2 then [0.5 0.2 0.1] means E[x1.^2] = 0.5, E[x1.*x2] = 0.2 and E[x2.*x2] = 0.1
%           if n=3 then [0.5 0.2 0.1] means E[x1] = 0.5, E[x2] = 0.2 and E[x3] = 0.1
%
% LIMITATIONS:
%   The discrete laplacian and implicit boundary condition may not be the most sensible
%   objective function, especially in the 3-d case as currently implemented (I'm hoping someone
%   improves this). One might also replace the atomic measure with mixture of gaussians
%   centred at the lattice points.
%
% RELATED:
%   ksdensity.m - stats toolbox
%
% Peter Cotton

momentConstraintMultiplier = 1;

if nargin==0 || ischar(xs) && strcmpi(xs,'demo'),
    laplaceDemo;
else

    %% Limitations and checks
    [m,n,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin{:});

    %% Establish grid points
    X = cell(n,1);
    switch n
        case 1,
            if ~iscell(xs),
                error('laplace: Violation of programmer intent - xs should have been set to cell by laplaceArgChecks');
            elseif iscell(xs),
                X = xs;
            else
                error('Not sure how to interpret xs');
            end
        otherwise
            [X{:}] = ndgrid(xs{:});
    end

    %% Ensure probs add to one.
    if isempty(AEq),
        AEq = ones(1,prod(m));
        bEq = 1;
    else
        AEq = [AEq;ones(1,prod(m))];
        bEq = [bEq;1];
    end

    %% Interpret additional arguments as equality constraints
    nsumk_ = nan(n,1);
    for k=1:10,
        nsumk_(k) = nsumk(n,k);
    end
    nArgs = length(varargin);
    moments = cell(nArgs,1);
    for argNo=1:length(varargin),
        arg_ = varargin{argNo};
        if isvector(arg_),
            switch n
                case 1,
                    degree_ = argNo;
                    expon = degree_;
                    nExpon= 1;
                otherwise
                    degree_ = find(nsumk_==length(arg_),1);
                    if isempty(degree_),
                        error([num2str(k),'th argument appears to have the wrong number of moments']);
                    else
                        [~,expon] = nsumk(n,degree_); % Listing of all non-negs adding to degree_
                        nExpon = size(expon,1);
                        expon = expon(nExpon:-1:1,:); % Reverse lexicographic ordering is more natural for moments
                    end
            end
            moments_ = nan(prod(m),nExpon);
            for i=1:nExpon,
                % Tabulate pointwise value of polynomial in x1, x2 and x3
                xi = X{1}(:);
                moments_(:,i) = xi.^expon(i,1);
                for j=2:n,
                    xj = X{j}(:);
                    moments_(:,i) = moments_(:,i).*(xj.^expon(i,j));
                end
            end
            AEq = [AEq;momentConstraintMultiplier*moments_'];
            bEq = [bEq;momentConstraintMultiplier*arg_(:)];
            moments{argNo} = moments_;
        end
    end

    %% Optimize discrete laplacian
    switch n
        case 1,
            f = @(p) del(p,xs);
        otherwise
            unrol = @(P) P(:);
            f = @(p) unrol(del(reshape(p,m'),xs));
    end
    [C,shouldBeZero] = inferAffineMap(f,prod(m));
    if any(abs(shouldBeZero)),
        error('laplace: Violation of programmer intent (bug). Discrete laplacian should not have constant term');
    end
    H = full(C'*C);
    options = optimset('LargeScale','off','MaxIter',500,'TolX',1e-2,'MaxFunEvals',1000);
    lb = zeros(prod(m),1);
    ub = ones(prod(m),1);
    p = quadprog(H,zeros(prod(m),1),A,b,AEq,bEq,lb,ub,zeros(prod(m),1),options);
    if n>1,
        P = reshape(p,m');
    else
        P = p;
    end

    %% Return moments implied by the atomic measure
    vargout = cell(length(varargin),1);
    for argNo=1:length(varargin),
        if ~isempty(moments{argNo}),
            vargout{argNo} = (p'*moments{argNo})';
        end
    end
    varargout = cell(length(varargin),1);
    [varargout{:}] = vargout{:};
end

end

function L = del(P,xs)
% function L = del(P,xs)
%
% Augmented discrete laplacian for 1 or 2 dimensions
% Projected, augmented discrete laplacian for 3 dimensions

% Tabulate grid steps
hs = cell(1,length(xs));
for dimNo=1:length(xs),
    hs{dimNo} = xs{dimNo}(2)-xs{dimNo}(1);
end

if isvector(P),
    L = del1augmented(P,hs);
elseif length(size(P))==2,
    L = del2augmented(P,hs);
elseif length(size(P))==3,
    L = del3augmented(P,hs);
else
    error('laplace is not implemented for dimension four'); % TODO:
end

    function d = del1augmented(P,hs)
        d = del2([0;0;P(:);0;0],hs{:});
    end

    function d = del2augmented(P,hs)
        % Enlarges the area and then computes del2
        P_ = zeros(size(P)+4);
        P_(3:end-2,3:end-2) = P;
        d = del2(P_,hs{:});
    end

    function d = del3augmented(P,hs)
        % Enlarges the area and then computes del2
        P_ = zeros(size(P)+4);
        P_(3:end-2,3:end-2,3:end-2) = P;
        d = del3(P_,hs{:});
    end
    function L = del3(X,varargin)
        % FIXME: For now this returns the laplacians of 2-d marginals
        L = zeros(0,1);
        for k=1:3,
            idx_ = setdiff(1:3,k);
            d_ = del2(squeeze(sum(X,k)),varargin{idx_});
            if k==1,
                L = d_(:);
            else
                L = [L;d_(:)];
            end
        end
    end

end

function [m,n,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin)
% function [n,m,xs] = laplaceArgChecks(xs,A,b,AEq,bEq,varargin)
%
% Ensure arguments make sense, and infer dimension where necessary

%% Allow passing of single vector for lattice rather than cell array
if ~iscell(xs) && isvector(xs),
    % Try to infer dimension
    if ~isempty(A),
        n_ = log(size(A,2))/log(length(xs));
        n = round(n_);
        if abs(n-n_)>1e-6,
            error('error infering dimension of problem, A looks to be inconsistent');
        end
    elseif ~isempty(AEq),
        n_ = log(size(AEq,2))/log(length(xs));
        n = round(n_);
        if abs(n-n_)>1e-6,
            error('error infering dimension of problem, AEq looks to be inconsistent');
        end
    else
        n = length(varargin{1});
        if n>3,
            error('inferred dimension exceeds 3 - better to be explicit');
        end
    end
    oldLattice = xs;
    xs = cell(n,1);
    for k1=1:n,
        xs{k1} = oldLattice;
    end
end

%% Check dimensions
n = length(xs);
m = nan(n,1);
for k2=1:n,
    latticeValues = xs{k2};
    m(k2) = length(latticeValues);
    if ~isvector(latticeValues) || any(any(diff(latticeValues)<eps)) || any(any(abs(diff(diff(latticeValues)))>1e-6)),
        error(['laplace anticipates an evenly spaced vector of support points in increasing order: e.g. (-4:0.5:3). Problem with lattice{',num2str(k2),'}']);
    end
end
if ~isempty(A) && size(A,2)~=prod(m),
    error('laplace anticipates size(A,2)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(AEq) && size(AEq,2)~=prod(m),
    error('laplace anticipates size(AEq,2)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(b) && size(b,1)~=size(bEq,1),
    error('laplace anticipates size(b,1)=prod(m), where m(k) is the number of lattice points in dimension k');
end
if ~isempty(bEq) && size(bEq,1)~=size(AEq,1),
    error('laplace anticipates size(bEq,1)=prod(m), where m(k) is the number of lattice points in dimension k');
end

end

function [A,b] = inferAffineMap(f,n)
% f  function_handle
% A  m x n
%
% Deduce affine mapping given its function handle

b = feval(f,zeros(n,1));
m = length(b);
A = sparse(m,n);
for k=1:n,
    ek = zeros(n,1);
    ek(k) = 1;
    A(:,k) = feval(f,ek)-b;
end
end

function [m,x] = nsumk(n,k)
% NSUMK Number and listing of non-negative integer n-tuples summing to k
%    M = NSUMK(N,K) where N and K are positive integers returns M=nchoosek(K+N-1,N-1)
%    This is the number of ordered N-tuples of non-negative integers summing to K
%
%    [M,X] = NSUMK(N,K) produces a matrix X with
%    nchoosek(K+N-1,N-1) rows and n columns. Each row comprises
%    non-negative integers summing to k. The ordering of rows follows the
%    same convention as NCHOOSEK, which is undocumented but with some
%    reliability appears to be lexicographic. The reverse of this presumed ordering
%    is a natural way to list coefficients of polynomials in N variables of degree K.
%    As per nchoosek, this syntax is only practical for situations where N is
%    less than about 15.
%
%  EXAMPLES:   m = nsumk(5,2)
%              [~,x] = nsumk(5,2) returns a 15 x 5 matrix x in which rows sum to 2

if isscalar(n) && isscalar(k) && nargout<=1
    m = nchoosek(k+n-1,n-1);
elseif isscalar(n) && isscalar(k) && nargout==2,
    m = nchoosek(k+n-1,n-1);
    dividers = [zeros(m,1),nchoosek((1:(k+n-1))',n-1),ones(m,1)*(k+n)];
    x = diff(dividers,1,2)-1;
else
    error('nsumk anticipates scalar k and n');
end
end

function [y,expon] = kmoments(x,k)
%  KMOMENTS - Evaluate sample mean of all k'th degree polynomials in N-variables
%    Y = KMOMENTS(X,K) where X is an NSAMPLES by N matrix produces a NSUMK(N,K) x 1
%    vector Y comprising sample means for all K-degree polynomials in N variables
%    Samples for the j'th variable comprise the j'th column of X, and the
%    implied listing of k-degree polynomials follows reverse lexicographic ordering
%
%    [Y,expon] = KMOMENTS(X,K) also returns the reverse-lex ordered polynomial exponents
%    in a matrix of size NCHOOSEK(K+N-1,N-1) x N

%% Generate reverse lex ordering
n = size(x,2);
switch n
    case 1,
        expon = k; m=1;
    otherwise
        [~,expon] = nsumk(n,k);
        m = size(expon,1);
        expon = expon(m:-1:1,:);
end

y = ones(m,1);

%% Compute k-th degree polys for a sample x
for i=1:m,
    ys = ones(size(x,1),1);
    for j=1:n,
        ys = ys.*x(:,j).^expon(i,j);
    end
    y(i) = mean(ys);
end

end

function laplaceDemo
close all;

%% UNIVARIATE EXAMPLE:
% An example motivated by finance
% We are inferring a risk-neutral density from market prices
% Prices of call options are linear constraints on the atomic density
% We throw in a few moment constraints as well
% Don't take this too seriously in the tails

matchExactMoments = true;  % <-- Set to false to verify the dangers in fitting the wrong moments
compareShortAndLongSample = false; % <-- Set to true to use moments and 'prices' from 'true' distribution
xs = (-5:0.05:5)';

% Generate an imagined risk-neutral density sample
shortSample_ = [-0.1+0.2*randn(10,1);0.3*randn(50,1);0.5+0.5*randn(100,1)];
if compareShortAndLongSample,
   longSample_ = [-0.1+0.2*randn(10*10000,1);0.3*randn(50*10000,1);0.5+0.5*randn(100*10000,1)];
else
   longSample_ = shortSample_;
end
pShort = hist(shortSample_,xs);pShort = pShort/sum(pShort);
pLong = hist(longSample_,xs);pLong = pLong/sum(pLong);

% Generate imagined market prices for securities based on the risk-neutral density sample
strikes = [-1:0.5:1];
security = @(x) max(0,x*ones(1,length(strikes))-ones(size(x,1),1)*strikes); % (Call option) Takes  column vector x of length nSamples ->  nSamples x nStrikes matrix
securityMarketPrice = mean(security(longSample_))';
securityPayoff = security(xs)';

% Infer the density subject to price and moment constraints
allMoments = cell(5,1);
for mNo=1:length(allMoments),
    if matchExactMoments,
        allMoments{mNo} = kmoments(longSample_,mNo);
    else
        allMoments{mNo} = kmoments(shortSample_,mNo);
    end
end
for nMomentsUsed = 0:5,
    P = laplace(xs,[],[],securityPayoff,securityMarketPrice,allMoments{1:nMomentsUsed});
    subplot(2,3,nMomentsUsed+1);plot(xs,P,xs,pLong,xs,pShort);legend('laplace','long sample','short sample');ylabel(['Matched ',num2str(nMomentsUsed), ' moments']);
    grid; plotxs = axis;axis([-2,2,plotxs(3),plotxs(4)]);
    drawnow; pause(1);
end

%% BIVARIATE EXAMPLE
% Inferring a bivariate distribution from moments
figure;
xs = {(-4:0.5:4)',(-4:0.5:4)};
sample_ = mvnrnd([-0.1 0.3],[1.2,0.5;0.5,0.98],500);
sample_(:,1) = sample_(:,1);
sample_(:,2) = -0.5+sample_(:,2)+0.5./(1+abs(sample_(:,1)));
pEmpirical = hist3(sample_,xs);
pEmpirical = pEmpirical/sum(pEmpirical(:));
moments1 = kmoments(sample_,1);
moments2 = kmoments(sample_,2);
moments3 = kmoments(sample_,3);
moments4 = kmoments(sample_,4);
[P,m1,m2,m3,m4] = laplace(xs,[],[],[],[],moments1,moments2,moments3,moments4);
subplot(1,2,1);surf(pEmpirical);zlabel('Empirical');
subplot(1,2,2);surf(P);zlabel('Laplace minimizing');
bivariateMomentComparison = [[moments1;moments2;moments3;moments4],[m1;m2;m3;m4]],
drawnow; pause(1);

%% TRIVARIATE EXAMPLE
% Inferring a tri-variate distribution from moments
figure;
disp('Trivariate example takes a little while...');
nTrivariateMomentsToUse = 3;
xs = {(-3:1:3)',(-3:1:3),(-3:1:3)};
sample_ = mvnrnd([-0.1 0.3 0.1],[1.2,0.5,0.2;0.5,0.98,0.35;0.2,0.35,1.2],50);
triMoments = cell(nTrivariateMomentsToUse,1);
for mNo=1:length(triMoments),
   triMoments{mNo}= kmoments(sample_,mNo);
end
P = laplace(xs,[],[],[],[],triMoments{:});
Pxy = squeeze(sum(P,3));
pxyEmpirical = hist3(sample_(:,[1:2]),xs(1:2)); pxyEmpirical = pxyEmpirical/sum(pxyEmpirical(:));
subplot(1,2,1);surf(pxyEmpirical);zlabel('Empirical (xy projection)');
subplot(1,2,2);surf(Pxy);zlabel('Laplace minimizing (xy projection)');

end


close all;
clearvars;
clc;
[LoD,HiD,LoR,HiR] = wfilters('db4');

load noisdopp;

% change the DWT mode to periodization.
old_dwt_mode = dwtmode('status','nodisp');
dwtmode('per');
% perform 4 level decomposition
[coefficients, levels] = wavedec(noisdopp,4, LoD,HiD);

% plot approximation and detail components
figure;
plot(coefficients); title('Coefficients');

export_fig images/noisdopp_db4_l4_decomposition_per.png -r120 -nocrop;

% reconstruct the signal
reconstructed = waverec(coefficients, levels, LoR, HiR);

% measure the maximum difference
max_abs_diff = max(abs(noisdopp-reconstructed))

figure;
for level=0:4
    level_app_coeffs = appcoef(coefficients, levels, LoR, HiR, level);
    subplot(511+level);
    plot(level_app_coeffs);
    fprintf('%d ', numel(level_app_coeffs));
    title(sprintf('Approximation coefficients @ level-%d', level));
end

% restore the old DWT mode
dwtmode(old_dwt_mode);

export_fig images/noisdopp_db4_l4_appcoeffs_per.png -r120 -nocrop;


function [Q,Z,QAZ,QBZ]=HessenbergTriRed(A,B)
%%HESSENBERGTRIRED Perform a Hessenberg triangular reduction. Given A and
%             B, two nXn matrices, find orthogonal matrices Q and Z such
%             that Q'*A*Z is an upper Hessenberg matrix and Q'*B*Z is an
%             upper triangular matrix.  An upper Hessenberg matrix has zero
%             entries below the first subdisgonal and is thus almost upper
%             triangular. This implementation is only for real matrices.
%
%INPUTS: A, B Two nXn real matrices.
%
%OUTPUTS Q,Z Orthogonal nXn matrices such that Q'*A*Z is upper Hessenberg
%            and Q'*B*Z is lower triangular.
%        QAZ The matrix Q'*A*Z.
%        QBZThe matrix Q'*B*Z
%
%This implements algorithm 7.7.1 in Chapter 7.7.4 of [1], modified to
%obtain the Q and Z matrices explicitly. This is similar to the hess
%function in Matlab.
%
%REFERENCES:
%[1] G. H. Golub and C. F. Van Loan, Matrix Computations, 4th ed.
%    Baltimore: Johns Hopkins University Press, 2013.
%
%November 2015 David F. Crouse, Naval Research Laboratory, Washington D.C.
%(UNCLASSIFIED) DISTRIBUTION STATEMENT A. Approved for public release.

n=size(A,1);

%The initial upper triangularization. We are just using qr and not
%Algorithm 5.2.1.
%Make B upper triangular
[Q,B]=qr(B,0);
A=Q'*A;%Adjust A accordingly

Z=eye(n,n);
for j=1:(n-2)
    for i=n:-1:(j+2)
        %Zero A(i,j)
        [c,s]=GivensCS(A(i-1,j),A(i,j));
        A((i-1):i,j:n)=[c, s;-s,c]'*A(i-1:i,j:n);
        B((i-1):i,(i-1):n)=[c, s;-s,c]'*B(i-1:i,i-1:n);
        %Store the transformation
        Q(:,(i-1):i)=Q(:,(i-1):i)*[c,s;-s,c];
        %Zero B(i,j)
        [c,s]=GivensCS(-B(i,i),B(i,i-1));
        B(1:i,i-1:i) = B(1:i,i-1:i)*[c,s;-s,c];
        A(1:n,i-1:i) = A(1:n,i-1:i)*[c,s;-s,c];
        Z(:,(i-1):i) = Z(:,(i-1):i)*[c,s;-s,c];
    end
end

%Save the results.
QAZ=A;
QBZ=B;
end

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


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

%*****************************************************************************80
%
%% JACOBI_EK_COMPUTE: Elhay-Kautsky method for Gauss-Jacobi quadrature rule.
%
%  Discussion:
%
%    The integral:
%
%      integral ( -1 <= x <= 1 ) (1-x)^alpha * (1+x)^beta * f(x) dx
%
%    The quadrature rule:
%
%      sum ( 1 <= i <= n ) w(i) * f ( x(i) )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 June 2011
%
%  Author:
%
%    Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Sylvan Elhay, Jaroslav Kautsky,
%    Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of
%    Interpolatory Quadrature,
%    ACM Transactions on Mathematical Software,
%    Volume 13, Number 4, December 1987, pages 399-415.
%
%  Parameters:
%
%    Input, integer N, the order.
%
%    Input, real ALPHA, BETA, the exponents of (1-X) and
%    (1+X) in the quadrature rule.  For simple Gauss-Legendre quadrature,
%    set ALPHA = BETA = 0.0.  -1.0 < ALPHA and -1.0 < BETA are required.
%
%    Output, real X(N), the abscissas.
%
%    Output, real W(N), the weights.
%

%
%  Define the zero-th moment.
%
  zemu = 2.0^( alpha + beta + 1.0 ) ...
    * gamma ( alpha + 1.0 ) ...
    * gamma ( beta + 1.0 ) ...
    / gamma ( 2.0 + alpha + beta );
%
%  Define the Jacobi matrix.
%
  x(1) = ( beta - alpha ) / ( 2.0 + alpha + beta );

  bj(1) = 4.0 * ( 1.0 + alpha ) * ( 1.0 + beta ) ...
    / ( ( 3.0 + alpha + beta ) * ( 2.0 + alpha + beta )^2 );

  for i = 2 : n
    abi = 2.0 * i + alpha + beta;
    x(i) = ( beta + alpha ) * ( beta - alpha ) / ( ( abi - 2.0 ) * abi );
    bj(i) = 4.0 * i * ( i + alpha ) * ( i + beta ) ...
      * ( i + alpha + beta ) ...
      / ( ( abi - 1.0 ) * ( abi + 1.0 ) * abi * abi );
  end

  bj(1:n) = sqrt ( bj(1:n) );

  w = zeros(n,1);

  w(1) = sqrt ( zemu );
  w(2:n) = 0.0;
%
%  Diagonalize the Jacobi matrix.
%
  [ x, w ] = imtqlx ( n, x, bj, w );

  w(1:n) = w(1:n).^2;

  return
end


function [ res, jac ] = opt14_rj ( x, flag )

%*****************************************************************************80
%
%% OPT14_RJ evaluates RES and JAC for test case #14.
%
%  Modified:
%
%    07 January 2008
%
%  Author:
%
%    Jeff Borggaard,
%    Gene Cliff,
%    Virginia Tech.
%
%  Reference:
%
%    John Dennis, Robert Schnabel,
%    Numerical Methods for Unconstrained Optimization
%    and Nonlinear Equations,
%    SIAM, 1996,
%    ISBN13: 978-0-898713-64-0,
%    LC: QA402.5.D44.
%
%  Parameters:
%
%    Input, real X(3), the evaluation point.
%
%    Input, string FLAG, indicates what must be computed.
%    'f' means only the value of RES is needed,
%    'g' means only the value of JAC is needed,
%    'all' means RES and JAC are needed.
%    It is acceptable to behave as though FLAG was 'all'
%    on every call.
%
%    Output, real RES(3,1), the function column vector.
%
%    Output, real JAC(3,3), the Jacobian matrix.
%
  n = length ( x );

  if ( n ~= 3 )
    fprintf ( '\n' );
    fprintf ( 'OPT14_RJ - Fatal error!\n' );
    fprintf ( '  The input vector X should have length 3.\n'),
    fprintf ( '  Instead, it has length = %d.\n', n );
    keyboard
  end

  res = zeros(n,1);

  res(1,1) = x(1)^2*x(2) + x(1)*x(2)^2;
  res(2,1) = 3 * x(1) * x(2)^2 * x(3) - x(1) * x(3) - 1;
  res(3,1) = x(1)*x(3) - 2;

  jac = zeros(n,n);

  jac(1,1) = 2 * x(1) * x(2) + x(2)^2;
  jac(1,2) = x(1)^2 + 2 * x(1) * x(2);
  jac(1,3) = 0;

  jac(2,1) = 3 * x(2)^2 * x(3) - x(3);
  jac(2,2) = 3 * 2 * x(1) * x(2) * x(3);
  jac(2,3) = 3 * x(1) * x(2)^2 - x(1);

  jac(3,1) = x(3);
  jac(3,2) = 0;
  jac(3,3) = x(1);


function f=chi2pdf(x,k)

% f=chi2pdf(x,k)
%
% Return the pdf of a chi-squared distribution with k degrees of freedom
% evaluated at x.

% Copyright 2012 Evrytania LLC (http://www.evrytania.com)
%
% Written by James Peroulas <james@evrytania.com>
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation, either version 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/>.

error(nargchk(2,2,nargin));
error(chk_param(x,'x','numeric','real'));
error(chk_param(k,'k','scalar','real','integer','>=',1));

f=NaN(size(x));
f(x<0)=0;
xgt0=x>=0;
f(xgt0)=x(xgt0).^(k/2-1).*exp(-x(xgt0)/2)/(2^(k/2)*gamma(k/2));


function p = predict(theta, X)
%PREDICT Predict whether the label is 0 or 1 using learned logistic
%regression parameters theta
%   p = PREDICT(theta, X) computes the predictions for X using a
%   threshold at 0.5 (i.e., if sigmoid(theta'*x) >= 0.5, predict 1)

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

% You need to return the following variables correctly
p = zeros(m, 1);

% ====================== YOUR CODE HERE ======================
% Instructions: Complete the following code to make predictions using
%               your learned logistic regression parameters.
%               You should set p to a vector of 0's and 1's
%

p = round(sigmoid(X * theta))

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

end


function fx = p49_fun ( n, x )

%*****************************************************************************80
%
%% P49_FUN evaluates the integrand for problem 49.
%
%  Discussion:
%
%    The function is singular at two internal points, 1 and sqrt(2).
%
%  Interval:
%
%    0 <= x <= 3
%
%  Integrand:
%
%    x^3 * log ( abs ( ( x^2 - 1 ) * ( x^2 - 2 ) ) )
%
%  Exact Integral:
%
%    61 log ( 2 ) + (77/4) log ( 7 ) - 27 = 52.7408...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Robert Piessens, Elise de Doncker-Kapenga,
%    Christian Ueberhuber, David Kahaner,
%    QUADPACK: A Subroutine Package for Automatic Integration,
%    Springer, 1983, page 104.
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(N), the evaluation points.
%
%    Output, real FX(N), the integrand values.
%
  x = x ( : );

  fx(1:n,1) = abs ( ( x(1:n,1).^2 - 1.0 ) .* ( x(1:n,1).^2 - 2.0 ) );
  i = ( fx == 0.0 );
  fx = x.^3 .* log ( fx );
  fx(i) = 0.0;

  return
end


% Fig. 6.43   Feedback Control of Dynamic Systems, 6e
%             Franklin, Powell, Emami
%

clear all;
%close all;
clf

num=86*conv([1 1],[1 2 43.25]);
p=conv([1 2 82],[1 2 101]);
den=conv([1 0 0],p);
w=logspace(-1,2,1000);
[mag,phas]=bode(num,den,w);
figure(1)
loglog(w,mag,w,ones(size(w)));
axis([.1 100 .01 10])
xlabel('\omega (rad/sec)');
ylabel('magnitude');
title('Fig. 6.43 : Bode plot for Example 6.12 (a) magnitude');
bodegrid;
%pause;
figure(2)
semilogx(w,phas,w,-180*ones(size(w)));
xlabel('\omega (rad/sec)');
ylabel('phase (deg)');
title('Fig. 6.43 : Bode plot for Example 6.13 (b) phase');
bodegrid;

% actually, the GMs and PMs are slightly different for the system here
% than that described in the text, the differences arose from
% roundoff because the initial design was done by hand.  The ideas
% are unchanged.


function g = sigmoidGradient(z)
%SIGMOIDGRADIENT returns the gradient of the sigmoid function
%evaluated at z
%   g = SIGMOIDGRADIENT(z) computes the gradient of the sigmoid function
%   evaluated at z. This should work regardless if z is a matrix or a
%   vector. In particular, if z is a vector or matrix, you should return
%   the gradient for each element.

g = zeros(size(z));

% ====================== YOUR CODE HERE ======================
% Instructions: Compute the gradient of the sigmoid function evaluated at
%               each value of z (z can be a matrix, vector or scalar).

g = sigmoid(z).*(1-sigmoid(z));

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

end


function y = gskewness(x,n)
%GSKEWNESS Skewness of a grouped sample.
%  In some scientific works, once the data have been gathered from a
%  population of interest, it is often difficult to get a sense of what
%  the data indicate when they are presented in an unorganized fashion.
%  Assembling the raw data into a meaningful form, such as a frequency
%  distribution, makes the data easier to understand and interpret. It is
%  in the context of frequency distributions that the importance of
%  conveying in a succinct way numerical information contained in the data
%  is encountered.
%  So, grouped data is data that has been organized into groups known as
%  classes.  The raw dataset can be organized by constructing a table
%  showing the frequency distribution of the variable (whose values are
%  given in the raw dataset). Such a frequency table is often referred to
%  as grouped data.
%  Here, we developed a m-code to calculate the skewness of a grouped data.
%  One can input the returns or modified vectors n and xout containing the
%  frequency counts and the bin locations of the hist m-function, in a
%  column form matrix.
%  GSKEWNESS(X,0) adjusts the skewness for bias (correction by small sample
%  size). GSKEWNESS(X,1) is the same as GSKEWNESS(X), and does not adjust
%  for bias.
%  If skewness = 0, the data are perfectly symmetrical. But a skewness of
%  exactly zero is quite unlikely for real-world data. Here, we use the
%  Bulmers' rule of thumb criterium (1979), about how we can to
%  interpret the skewness number:
%  - Less than ?1 or greater than +1, the distribution is highly skewed
%  - Between ?1 and ?0.5 or between +0.5 and +1, the distribution is
%    moderately skewed
%  - Between ?0.5 and +0.5, the distribution is approximately symmetric
%
%  Skewness calculation uses the formula,
%
%           g1 =  m3/m2^1.5, do not adjusted for bias
%
%           G1 = SQRT(N*(N - 1))/(N - 2) * g1, adjusted for bias
%
%  where:
%  m2 = second moment of the sample about its mean
%  m3 = third moment of the sample about its mean
%  N  = sample size
%
%  Syntax: function y = gskewness(x,n)
%
%  Inputs:
%       x - data matrix (Size of matrix must be n-by-2; absolut frequency=
%           column 1, class mark=column 2)
%       n - adjusted for bias = 0 (default), do not adjust for bias = 1
%  Outputs:
%       y  - skewness of the values in x
%
%  Example: Suppose we have the next frequency table:
%
%                     ----------------
%                       MC         F
%                     ----------------
%                       61         5
%                       64        18
%                       67        42
%                       70        27
%                       73         8
%                     ----------------
%
%  Taken from: http://www.tc3.edu/instruct/sbrown/stat/shape.htm
%
%  Where we are interested to get the skewness value adjusted for bias.
%
%  Data input:
%  x=[61 5;64 18;67 42;70 27;73 8];
%
%  Calling on Matlab the function:
%          y = gskewness(x,0)
%
%  Answer is:
%
%  y = -0.1098
%
%  Created by A. Trujillo-Ortiz, R. Hernandez-Walls and
%             C.M. Espinosa-Lagunes
%             Facultad de Ciencias Marinas
%             Universidad Autonoma de Baja California
%             Apdo. Postal 453
%             Ensenada, Baja California
%             Mexico.
%             atrujo@uabc.edu.mx
%
%  Copyright (C)  September 24, 2012.
%
%  To cite this file, this would be an appropriate format:
%  Trujillo-Ortiz, A., R. Hernandez-Walls and C.M. Espinosa-Lagunes. (2012).
%     gskewness:Skewness of a grouped sample. [WWW document].
%     URL http://www.mathworks.com/matlabcentral/fileexchange/
%     38319-gskewness
%
%  References:
%  Bulmer, M. G. (1979), Principles of Statistics. NY:Dover Books on
%             Mathematics.
%  Jayaraman, K. (1999), A Statistical Manual for Foresty Research. Foresty
%             Research Support Programme for Asia and the Pacific. FAO-
%             Corporate Document Repository. Forestry Statistics and Data
%             Collection.
%             URL http://www.fao.org/DOCREP/003/X6831E/X6831E00.HTM
%             PDF ftp://ftp.fao.org/docrep/fao/003/X6831E/X6831E00.pdf
%

if  nargin < 2,
    n = 1; %default
end

c = size(x,2);

if c ~= 2
    error('stats:gskewness:BadData','X must have two colums.');
end

mc = x(:,1); %class mark
f = x(:,2); %absolut frequency
s = sum(f.*mc);
m1 = s/sum(f);
m2 = sum(f.*(mc - m1).^2)/sum(f);
m3 = sum(f.*(mc - m1).^3)/sum(f);
g1 = m3/m2^1.5;

if n == 0;
    y = sqrt(sum(f)*(sum(f) - 1))/(sum(f) - 2) * g1; %skewness adjusted for
                                                     %bias
else n = 1; %default
    y = g1; %skewness not adjusted for bias
end

return,


function u = fem1d_heat_implicit ( x_num, x, t, dt, k_fun, ...
  rhs_fun, bc_fun, element_num, element_node, quad_num, u_old )

%*****************************************************************************80
%
%% FEM1D_HEAT_IMPLICIT: finite element method, 1D heat, implicit time steps.
%
%  Discussion:
%
%    This program solves
%
%      dUdT - k * d2UdX2 = f(X,T)
%
%    over the interval [A,B] with boundary conditions
%
%      U(A,T) = UA(T),
%      U(B,T) = UB(T),
%
%    over the time interval [T0,T1] with initial conditions
%
%      U(X,T0) = U0(X)
%
%    and specified functions k(X,T) and f(X,T).
%
%    The code uses the finite element method to approximate the second derivative
%    in space, and an implicit backward Euler approximation to the first
%    derivative in time.
%
%    For a test function Vi, we write
%
%      dUdt Vi - k * d2Udx2 * Vi = f(x,t) * Vi
%
%      Int dUdt Vi - k d2Udx2 * Vi    = Int f(x,t) Vi
%      Int dUdt Vi + k dUdx   * dVidx = Int f(x,t) Vi
%
%    Take the backward Euler approximation to the derivative:
%
%      Int ( U(x,t) - U(x,t-dt) ) / dt Vi + k dUdx dVidx = Int ( f(x,t) Vi )
%
%    Now, assume the finite element projection:
%
%      U(x,t)    = sum ( uj     * Vj )
%      U(x,t-dt) = sum ( u_oldj * Vj )
%      F(x,t)    = sum ( fj     * Vj ):
%
%    Then the equation can be rewritten as:
%
%      Sum ( Int ( Vi Vj ) * ( uj - u_oldj ) / dt + k dVidx dVjdx * uj ) =
%        Sum ( Int ( Vi Vj * fj ) )
%
%    Carrying the old U to the right hand side, we have:
%
%      Sum ( Int ( Vi Vj ) * u / dt + k dVidx dVjdx * uj ) =
%        Sum ( Int ( Vi Vj * ( fj + u_oldj / dt ) ) )
%
%    or, written as a linear system for coefficients "u":
%
%      ( K + M/dT ) * u = b + c
%
%    where K is the usual stiffness matrix, M is the standard finite element
%    mass matrix, b is the usual right hand side, and c contains additions to
%    the right hand side from the time term.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer X_NUM, the number of points to use in the spatial dimension.
%
%    Input, real X(X_NUM,1), the coordinates of the nodes.
%
%    Input, real T, the current time.
%
%    Input, real DT, the size of the time step.
%
%    Input, real K_FUN(), a function to evaluate the heat conductivity.
%
%    Input, real RHS_FUN(), a function to evaluate the right hand side.
%
%    Input, real BC_FUN(), a function to set the Dirichlet conditions.
%
%    Input, integer ELEMENT_NUM, the number of elements.
%
%    Input, integer ELEMENT_NODE(2,ELEMENT_NUM), the nodes belonging to
%    each element.
%
%    Input, integer QUAD_NUM, the number of quadrature points to use.
%
%    Input, real U_OLD(X_NUM,1), the solution at time T - dt.
%
%    Output, real U(X_NUM,1), the solution at time T.
%
  [ a, b ] = assemble_fem ( x_num, x, element_num, element_node, ...
    quad_num, t, k_fun, rhs_fun );

  [ a, b ] = assemble_backward_euler ( x_num, x, element_num, ...
    element_node, quad_num, t, dt, u_old, a, b );

  [ a, b ] = assemble_bc ( x_num, x, t, bc_fun, a, b );

  u = a \ b;

  return
end


%% MULTIGRID FOR STOKES EQUATIONS IN 2D
%
% This example is to show the convergence of multigrid methods for various
% finite element approximation of the Stokes equation on the unit square:
%
%       -div(mu*grad u) + grad p = f in \Omega,
%                        - div u = 0  in \Omega,
%                              u = g_D  on \Gamma.
%
% with the pure Dirichlet boundary condition. The solver is based on a DGS
% type smoother and summarized in the following reference.
%
% Reference
%
% M. Wang and L. Chen. Multigrid Methods for the Stokes equations
% using Distributive Gauss-Seidel Relaxations based on the Least Squares
% Commutator. Journal of Scientific Computing. 56(2): 409-431, 2013.

clear variables;
close all;

%% Setting
% mesh
[node,elem] = squaremesh([0,1,0,1],0.25);
% [node,elem] = circlemesh(0,0,1,0.25);
showmesh(node,elem);
[node,elem] = uniformrefine(node,elem);
bdFlag = setboundary(node,elem,'Dirichlet');
mesh = struct('node',node,'elem',elem,'bdFlag',bdFlag);
figure; showmesh(node,elem); pause(0.5);
% pde
pde = Stokesdata2;
%  pde = StokesZulehnerdata;
% options
option.L0 = 0;
option.maxIt = 4;
option.printlevel = 1;
option.plotflag = 0;
option.rateflag = 0;

%% MG options
option.solver = 'mg';
option.smoothingstep = 2;
option.smootherbarSp = 'SGS';

%% RT0-P0
disp('RT0-P0')
option.elemType = 'RT0-P0';
% option.refType = 'bisect';
femStokesHdiv(mesh,pde,option);

%% BDM1B-P0
disp('BDM1B-P0')
option.elemType = 'BDM1B-P0';
femStokesHdiv(mesh,pde,option);

%% CR-P0 element
disp('CR-P0')
option.elemType = 'CRP0';
femStokes(mesh,pde,option);

%% P2-P0 element
disp('P2-P0')
option.elemType = 'P2P0';
femStokes(mesh,pde,option);

%% isoP2-P0 element
disp('isoP2-P0')
option.elemType = 'isoP2P0';
femStokes(mesh,pde,option);

%% isoP2-P1 element
disp('isoP2-P1')
option.elemType = 'isoP2P1';
femStokes(mesh,pde,option);

%% P1b-P1 element
disp('P1b-P0')
option.elemType = 'P1bP1';
option.solver = 'asmg';
femStokes(mesh,pde,option);

%% P2-P1 element
disp('P2-P1')
option.elemType = 'P2P1';
% option.smoothingStep = 3;
% option.smootherbarSp   = 'VCYCLE';
% option.smootherbarSpPara = 0.75;
femStokes(mesh,pde,option);


function g = sigmoidGradient(z)
%SIGMOIDGRADIENT returns the gradient of the sigmoid function
%evaluated at z
%   g = SIGMOIDGRADIENT(z) computes the gradient of the sigmoid function
%   evaluated at z. This should work regardless if z is a matrix or a
%   vector. In particular, if z is a vector or matrix, you should return
%   the gradient for each element.

g = zeros(size(z));

% ====================== YOUR CODE HERE ======================
% Instructions: Compute the gradient of the sigmoid function evaluated at
%               each value of z (z can be a matrix, vector or scalar).

g = sigmoid(z) .* (1 - sigmoid(z));

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

end


function [ x, seed ] = hypersphere_uniform_sample ( m, n, r, c, seed )

%*****************************************************************************80
%
%% HYPERSPHERE_SURFACE_UNIFORM samples hypersphere surface.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 May 2013
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Russell Cheng,
%    Random Variate Generation,
%    in Handbook of Simulation,
%    edited by Jerry Banks,
%    Wiley, 1998, pages 168.
%
%    George Marsaglia,
%    Choosing a point from the surface of a sphere,
%    Annals of Mathematical Statistics,
%    Volume 43, Number 2, April 1972, pages 645-646.
%
%    Reuven Rubinstein,
%    Monte Carlo Optimization, Simulation, and Sensitivity
%    of Queueing Networks,
%    Wiley, 1986, page 234.
%
%  Parameters:
%
%    Input, integer M, the dimension of the space.
%
%    Input, integer N, the number of points.
%
%    Input, real R, the radius of the sphere.
%
%    Input, real C(M,1), the center of the sphere.
%
%    Input/output, integer SEED, a seed for the random number generator.
%
%    Output, real X(M,N), the points.
%
  [ x, seed ] = r8mat_normal_01 ( m, n, seed );

  v(1,1:n) = sqrt ( sum ( x.^2, 1 ) );
  vv = repmat ( v, m, 1 );
  x = x ./ vv;
%
%  Scale by the sphere radius.
%
  x = r * x;
%
%  Shift to the sphere center.
%
  x = x + repmat ( c, 1, n );

  return
end


function [parent_pop] = srn(parent_pop)
%   This procedure implements srn (Srinivas and Deb's) function.
%   The canonical srn function is defined as below --
%       f1 = 2.0 + ((x_1 - 2.0)^2.0) + ((x_2 - 1.0)^2.0)
%       f2 = (9.0 * x_1) - ((x_2 - 1.0) ^ 2.0)
%       s.t.
%           c_1(x) = 1.0 - ((x_1^2.0) + (x_2^2.0))/225.0
%           c_2(x) = (3.0 * x_2/10.0) - (x_1/10.0) - 1.0
%       where
%           -20.0 <= x_i <= 20.0    (i = 1,2)

global nreal ;
global ncon ;
global nobj ;

cindex = nreal + nobj + 1 : nreal + nobj + ncon ;

x = parent_pop(:,1:nreal);
f1 = 2.0 + ((x(:,1) - 2.0) .^ 2.0) + ((x(:,2) - 1.0) .^ 2.0);
f2 = (9.0 .* x(:,1)) - ((x(:,2) - 1.0) .^ 2.0);

c = parent_pop(:,cindex) ;
c(:,1) = 1.0 - (((x(:,1) .^ 2.0) + (x(:,2) .^ 2.0)) ./ 225.0);
c(:,2) = (3.0 .* (x(:,2) ./ 10.0)) - (x(:,1) ./ 10.0) - 1.0 ;

parent_pop(:, (nreal+1)) = f1 ;
parent_pop(:, (nreal+2)) = f2 ;
parent_pop(:, cindex) = c ;
end


function [dSP,sp]=grShortPath(E,s,t)
% Function dSP=grShortPath(E) solve the task about
% the shortest path between any vertexes of digraph.
% Input parameter:
%   E(m,2) or (m,3) - the arrows of digraph and their weight;
%     1st and 2nd elements of each row is numbers of vertexes;
%     3rd elements of each row is weight of arrow;
%     m - number of arrows.
%     If we set the array E(m,2), then all weights is 1.
% Output parameter:
%   dSP(n,n) - the matrix of shortest path.
%   Each element dSP(i,j) is the shortest path
%   from vertex i to vertex j (may be inf,
%   if vertex j is not accessible from vertex i).
% Uses the algorithm of R.W.Floyd, S.A.Warshall.
% [dSP,sp]=grShortPath(E,s,t) - find also
% the shortest paths from vertex s (source) to vertex t (tail).
% In this case output parameter sp is vector with numbers
% of vertexes, included to shortest path from s to t.
% Author: Sergiy Iglin
% e-mail: siglin@yandex.ru
% personal page: http://iglin.exponenta.ru
% Acknowledgements to Prof. Gerard Biau
% (Universite Montpellier II, France)
% for testing of this algorithm.

% ============= Input data validation ==================
if nargin<1,
  error('There are no input data!')
end
[m,n,E] = grValidation(E); % E data validation

% ================ Initial values ===============
dSP=ones(n)*inf; % initial distances
dSP((E(:,2)-1)*n+E(:,1))=E(:,3);

% ========= The main cycle of Floyd-Warshall algorithm =========
for j=1:n,
  i=setdiff((1:n),j);
  dSP(i,i)=min(dSP(i,i),repmat(dSP(i,j),1,n-1)+repmat(dSP(j,i),n-1,1));
end
sp=[];
if (nargin<3)|(isempty(s))|(isempty(t)),
  return
end
s=s(1);
t=t(1);
if (~(s==round(s)))|(~(t==round(t)))|(s<1)|(s>n)|(t<1)|(t>n),
  error(['s and t must be integer from 1 to ' num2str(n)])
end
if isinf(dSP(s,t)), % t is not accessible from s
  return
end
dSP1=dSP;
dSP1(1:n+1:n^2)=0; % modified dSP
l=ones(m,1); % label for each arrow
sp=t; % final vertex
while ~(sp(1)==s),
  nv=find((E(:,2)==sp(1))&l); % all labeled arrows to sp(1)
  vnv=abs((dSP1(s,sp(1))-dSP1(s,E(nv,1)))'-E(nv,3))<eps*1e3; % valided arrows
  l(nv(~vnv))=0; % labels of not valided arrows
  if all(~vnv), % invalided arrows
    l(find((E(:,1)==sp(1))&(E(:,2)==sp(2))))=0;
    sp=sp(2:end); % one step back
  else
    nv=nv(vnv); % rested vaded arrows
    sp=[E(nv(1),1) sp]; % add one vertex to shortest path
  end
end
return


function fx = p33_fun ( n, x )

%*****************************************************************************80
%
%% P33_FUN evaluates the integrand for problem 33.
%
%  Discussion:
%
%    The integrand is singular at both endpoints of the interval.
%
%  Interval:
%
%    0 <= x <= 1
%
%  Integrand:
%
%    sqrt ( - ln ( x ) )
%
%  Exact Integral:
%
%    sqrt ( pi ) / 2
%
%  Approximate Integral (20 digits):
%
%    0.88622692545275801365...
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 November 2009
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Kendall Atkinson,
%    An Introduction to Numerical Analysis,
%    Prentice Hall, 1984, page 307.
%
%  Parameters:
%
%    Input, integer N, the number of evaluation points.
%
%    Input, real X(N), the evaluation points.
%
%    Output, real FX(N), the integrand values.
%
  fx = sqrt ( - log ( x ) );

  i = find ( x == 0.0 );
  fx(i) = 0.0;

  return
end


function ROT = createRotationVector3d(A,B)
%CREATEROTATIONVECTOR3D Calculates the rotation between two vectors.
%
%   ROT = createRotationVector3d(A, B) returns the 4x4 rotation matrix ROT
%   to transform vector A in the same direction as vector B.
%
%   Example
%     A=[ .1  .2  .3];
%     B=-1+2.*rand(1,3);
%     ROT = createRotationVector3d(A,B);
%     C = transformVector3d(A,ROT);
%     figure('color','w'); hold on; view(3)
%     O=[0 0 0];
%     drawVector3d(O, A,'r');
%     drawVector3d(O, B,'g');
%     drawVector3d(O, C,'r');
%
%   See also
%   transformPoint3d, createRotationOx, createRotationOy, createRotationOz
%
%   Source
%     https://math.stackexchange.com/a/897677
%
% ---------
% Author: oqilipo
% Created: 2017-08-07
% Copyright 2017

if isParallel3d(A,B)
    if A*B'>0
        ROT = eye(4);
    else
        ROT = -1*eye(4); ROT(end)=1;
    end
else
    a=normalizeVector3d(A);
    b=normalizeVector3d(B);
    a=reshape(a,3,1);
    b=reshape(b,3,1);

    v = cross(a,b);
    ssc = [0 -v(3) v(2); v(3) 0 -v(1); -v(2) v(1) 0];
    ROT = eye(3) + ssc + ssc^2*(1-dot(a,b))/(norm(v))^2;

    ROT = [ROT, [0;0;0]; 0 0 0 1];
end

end


function Cs = subgraph_centrality(CIJ)
% SUBGRAPH_CENTRALITY     subgraph centrality of a network
%
%   Cs = subgraph_centrality(CIJ)
%
%   The subgraph centrality of a node is a weighted sum of closed walks of
%   different lengths in the network starting and ending at the node. This
%   function returns a vector of subgraph centralities for each node of the
%   network.
%
%   Inputs:     CIJ,        adjacency matrix (binary)
%
%   Outputs:     Cs,        subgraph centrality
%
%   Reference: Estrada and Rodriguez-Velasquez (2005) Phys Rev E 71, 056103
%              Estrada and Higham (2010) SIAM Rev 52, 696.
%
%   Xi-Nian Zuo, Chinese Academy of Sciences, 2010
%   Rick Betzel, Indiana University, 2012

[V,lambda] = eig(CIJ);                 % Compute the eigenvectors and
lambda     = diag(lambda);             % eigenvalues.
V2         = V.^2;                     % Matrix of squares of the eigenvectors elements.
Cs         = real(V2 * exp(lambda));   % Compute eigenvector centrality. Lop off imaginary part remaining due to precision error.


function value = c1_jac_monomial_integral ( alpha, beta, expon )

%*****************************************************************************80
%
%% C1_JAC_MONOMIAL_INTEGRAL: integral of a monomial with Jacobi weight over C1.
%
%  Discussion:
%
%    value = integral ( -1 <= x <= +1 ) x^expon (1-x)^alpha (1+x)^beta dx
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    27 January 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, real ALPHA, the exponent of (1-X) in the weight factor.
%
%    Input, real BETA, the exponent of (1+X) in the weight factor.
%
%    Input, integer EXPON, the exponent.
%
%    Output, real VALUE, the value of the integral.
%
  c = expon;

  if ( mod ( expon, 2 ) == 0 )
    s = +1.0;
  else
    s = -1.0;
  end

  arg1 = - alpha;;
  arg2 =   1.0 + c;
  arg3 =   2.0 + beta + c;
  arg4 = - 1.0;

  value1 = r8_hyper_2f1 ( arg1, arg2, arg3, arg4 );

  arg1 = - beta;
  arg2 =   1.0 + c;
  arg3 =   2.0 + alpha + c;
  arg4 = - 1.0;

  value2 = r8_hyper_2f1 ( arg1, arg2, arg3, arg4 );

  value = gamma ( 1.0 + c ) ...
    * ( s * gamma ( 1.0 + beta  ) * value1 / gamma ( 2.0 + beta  + c ) ...
    +       gamma ( 1.0 + alpha ) * value2 / gamma ( 2.0 + alpha + c ) );

  return
end


function d = p02_d ( m, id, c, w, n, x )

%*****************************************************************************80
%
%% P02_D evaluates a derivative for problem p02.
%
%  Discussion:
%
%    f(x) = 1 / product ( c(1:m)^(-2) + ( x(1:m) - w(1:m) )^2 )
%
%    Default values are:
%
%    c(1:m) = 1
%    w(1:m) = 0.5
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    26 August 2012
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Alan Genz,
%    A Package for Testing Multiple Integration Subroutines,
%    in Numerical Integration: Recent Developments, Software
%    and Applications,
%    edited by Patrick Keast and Graeme Fairweather,
%    Reidel, 1987, pages 337-340,
%    ISBN: 9027725144,
%    LC: QA299.3.N38.
%
%  Parameters:
%
%    Input, integer M, the spatial dimension.
%
%    Input, integer ID, the spatial coordinate to be differentiated.
%
%    Input, real C(M,1), W(M,1), the problem parameters.
%
%    Input, integer N, the number of points.
%
%    Input, real X(M,N), the evaluation points.
%
%    Output, real D(N,1), the value of the ID-th derivative component at X.
%
  d = ones ( n, 1 );
  for i = 1 : m
    d = d .* ( c(i) ^ (-2) + ( x(i,:)' - w(i) ) .^ 2 );
  end
  d = 1.0 ./ d .* ( - 2.0 ) .* ( x(id,:)' - w(id) ) ./ ...
    ( c(id) ^ (-2) + ( x(id,:)' - w(id) ) .^ 2 );

  return
end


function len = curveLength(varargin)
%CURVELENGTH return length of a curve (a list of points)
%
%   Compute the length of a curve given as a list of following points.
%
%   L = curveLength(X, Y);
%   L = curveLength(POINTS);
%   POINTS should be a [NxD] array, with N being the numbe of points and D
%   the dimension of the points.
%
%   PT = curveLength(..., TYPE);
%   Specifies if the last point is connected to the first one. TYPE can be
%   either 'closed' or 'open'.
%
%   TODO : specify norm (euclidian, taxi, ...).
%
%   Example:
%   Compute the perimeter of a circle with radius 1
%   curveLength(circleAsPolygon([0 0 1], 500), 'closed')
%   -> return 6.2831
%
%   See also:
%   polygons2d, curveCentroid
%
%   ---------
%
%   author : David Legland
%   INRA - TPV URPOI - BIA IMASTE
%   created the 14/06/2004
%

%   HISTORY
%   22/05/2006 manage any dimension for points, closed and open curves,
%       and update doc accordingly.
%   30/06/2009 deprecate and replace by 'polylineLength'.

% deprecation warning
warning('geom2d:deprecated', ...
    '''curveLength'' is deprecated, use ''polylineLength'' instead');

% check whether the curve is closed
closed = false;
var = varargin{end};
if ischar(var)
    if strcmpi(var, 'closed')
        closed = true;
    end
    varargin = varargin(1:end-1);
end

% extract point coordinates
if length(varargin)==1
    points = varargin{1};
elseif length(varargin)==2
    points = [varargin{1} varargin{2}];
end

% compute lengths of each line segment
if closed
    len = sum(sqrt(sum(diff(points([1:end 1],:)).^2, 2)));
else
    len = sum(sqrt(sum(diff(points).^2, 2)));
end


% sgwt_kernel_simple_tf : evaluates "simple" tight-frame kernel
%
% this is similar to meyer kernel, but simpler
%
% function is essentially sin^2(x) in ascending part,
% essentially cos^2 in descending part.
%
% function r= sgwt_kernel_simple_tf(x,kerneltype)
%
% Inputs
% x : array of independent variable values
% kerneltype : string, either 'sf' or 'wavelet'
%
% Ouputs
% r : array of function values, same size as x.
%
% simple tf wavelet kernel : supported on [1/4,1]
% simple tf scaling function kernel : supported on [0,1/2]
%

function r= sgwt_kernel_simple_tf(x,kerneltype)
% h : [0,1]->[0,1] must satisfy h(0)=0, h(1)=1 .
h=@(x) sin(pi*x/2).^2;

%r1ind=find(x>=0 & x<0.25);
r1ind=find(x<0.25);

r2ind=find(x>=.25 & x<0.5);
r3ind=find(x>=.5 & x<1);

r=zeros(size(x));

switch kerneltype
  case 'sf'
    r(r1ind)=1;
    r(r2ind)=sqrt(1-h(4*x(r2ind)-1).^2);
  case 'wavelet'
    r(r2ind)=h(4*(x(r2ind)-1/4));
    r(r3ind)=sqrt(1-h(2*x(r3ind)-1).^2);
end


function node_num = fem2d_bvp_serene_node_num ( nx, ny )

%*****************************************************************************80
%
%% FEM2D_BVP_SERENE_NODE_NUM counts the number of nodes.
%
%  Discussion:
%
%    The program uses the finite element method, with piecewise serendipity
%    basis functions to solve a 2D boundary value problem over a rectangle.
%
%    The grid uses NX nodes in the X direction and NY nodes in the Y direction.
%
%    Both NX and NY must be odd.
%
%    Because of the peculiar shape of the serendipity elements, counting the
%    number of nodes and variables is a little tricky.  Here is a grid for
%    the case when NX = 7 and NY = 5, for which there are 29 nodes
%    and variables.
%
%     23 24 25 26 27 28 29
%     19    20    21    22
%     12 13 14 15 16 17 18
%      8     9    10    11
%      1  2  3  4  5  6  7
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 June 2014
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer NX, NY, the number of X and Y grid values.
%    NX and NY must be odd and at least 3.
%
%    Output, integer NODE_NUM, the number of nodes and variables.
%
  node_num =   nx           * ( ny + 1 ) / 2 ...
           + ( nx + 1 ) / 2 * ( ny - 1 ) / 2;

  return
end


% compute squared Euclidean distance
% ||A-B||^2 = ||A||^2 + ||B||^2 - 2*A'*B
function d = L2_distance_1(a,b)
% a,b: two matrices. each column is a data
% d:   distance matrix of a and b

if (size(a,1) == 1)
  a = [a; zeros(1,size(a,2))];
  b = [b; zeros(1,size(b,2))];
end

aa=sum(a.*a); bb=sum(b.*b); ab=a'*b;
d = repmat(aa',[1 size(bb,2)]) + repmat(bb,[size(aa,2) 1]) - 2*ab;
d = real(d);
d = max(d,0);

% % force 0 on the diagonal?
d = d.*(1-eye(size(d)));
%d = d/size(a,1)^2;


function zbar = eval2dPoly( x, y, coeffs )
% Given the coefficients of a polynomial as returned by fit2dPolySVD,
% calculates the values z for input values (x,y).
% x, y are column vectors specifying the points to be calculated.
% The vectors must be the same length.
% Coeffs is the coefficients array returned by fit2dPolySVD.

[sizexR, sizexC] = size(x);
[sizeyR, sizeyC] = size(y);

if (sizexC ~= 1) || (sizeyC ~= 1)
    fprintf( 'Inputs of eval2dPoly must be column vectors' );
    return;
end

if (sizeyR ~= sizexR)
    fprintf( 'Inputs vectors of eval2dPoly must be the same length' );
    return;
end

numVals = sizexR;

order = 0.5 * (sqrt(8*length(coeffs)+1) - 3);

zbar = zeros(numVals,1);
column = 1;
for xpower = 0:order
    for ypower = 0:(order-xpower)
        zbar = zbar + (coeffs(column) .* x.^xpower .* y.^ypower);
        column = column + 1;
    end
end


function dy = diffxy(x,y,varargin)
% DIFFXY - accurate numerical derivative/differentiation of Y w.r.t X.
%
%   DY = DIFFXY(X,Y) returns the derivative of Y with respect to X using a
%        pseudo second-order accurate method. DY has the same size as Y.
%   DY = DIFFXY(X,Y,DIM) returns the derivative along the DIM-th dimension
%        of Y. The default is differentiation along the first
%        non-singleton dimension of Y.
%   DY = DIFFXY(X,Y,DIM,N) returns the N-th derivative of Y w.r.t. X.
%        The default is 1.
%
%   Y may be an array of any dimension.
%   X can be any of the following:
%       - array X with size(X) equal to size(Y)
%       - vector X with length(X) equal to size(Y,DIM)
%       - scalar X denotes the spacing increment
%   DIM and N are both integers, with 1<=DIM<=ndims(Y)
%
%   DIFFXY has been developed especially to handle unequally spaced data,
%   and features accurate treatment for end-points.
%
%   Example:
%   % Data with equal spacing
%     x = linspace(-1,2,20);
%     y = exp(x);
%
%     dy = diffxy(x,y);
%     dy2 = diffxy(x,dy);  % Or, could use >> dy2 = diffxy(x,y,[],2);
%     figure('Color','white')
%     plot(x,(y-dy)./y,'b*',x,(y-dy2)./y,'b^')
%
%     Dy = gradient(y)./gradient(x);
%     Dy2 = gradient(Dy)./gradient(x);
%     hold on
%     plot(x,(y-Dy)./y,'r*',x,(y-Dy2)./y,'r^')
%     title('Relative error in derivative approximation')
%     legend('diffxy: dy/dx','diffxy: d^2y/dx^2',...
%            'gradient: dy/dx','gradient: d^2y/dx^2')
%
%   Example:
%   % Data with unequal spacing.
%     x = 3*sort(rand(20,1))-1;
%     % Run the example above from y = exp(x)
%
%   See also DIFF, GRADIENT
%        and DERIVATIVE on the File Exchange

% for Matlab (should work for most versions)
% version 1.0 (Nov 2010)
% (c) Darren Rowland
% email: darrenjrowland@hotmail.com
%
% Keywords: derivative, differentiation

[h,dy,N,perm] = parse_inputs(x,y,varargin);
if isempty(dy)
    return
end
n = size(h,1);
i1 = 1:n-1;
i2 = 2:n;

for iter = 1:N
    v = diff(dy)./h;
    if n>1
        dy(i2,:) = (h(i1,:).*v(i2,:)+h(i2,:).*v(i1,:))./(h(i1,:)+h(i2,:));
        dy(1,:) = 2*v(1,:) - dy(2,:);
        dy(n+1,:) = 2*v(n,:) - dy(n,:);
    else
        dy(1,:) = v(1,:);
        dy(n+1,:) = dy(1,:);
    end
end

% Un-permute the derivative array to match y
dy = ipermute(dy,perm);

%%% Begin local functions %%%
function [h,dy,N,perm] = parse_inputs(x,y,v)

numvarargs = length(v);
if numvarargs > 2
    error('diffxy:TooManyInputs', ...
        'requires at most 2 optional inputs');
end

h = [];
N = [];
perm = [];

% derivative along first non-singleton dimension by default
dim = find(size(y)>1);
% Return if dim is empty
if isempty(dim)
    dy = [];
    return
end
dim = dim(1);

% Set defaults for optional arguments
optargs = {dim 1};
newVals = ~cellfun('isempty', v);
optargs(newVals) = v(newVals);
[dim, N] = optargs{:};

% Error check on inputs
if dim<1 || dim>ndims(y) || dim~=fix(dim) || ~isreal(dim)
    error('diffxy:InvalidOptionalArg',...
        'dim must be specified as a non-negative integer')
end
if N~=fix(N) || ~isreal(N)
    error('diffxy:InvalidOptionalArg',...
        'N must be an integer')
end

% permutation which will bring the target dimension to the front
perm = 1:length(size(y));
perm(dim) = [];
perm = [dim perm];
dy = permute(y,perm);

if length(x)==1  % Scalar expansion to match size of diff(dy,[],1)
    sizeh = size(dy);
    sizeh(1) = sizeh(1) - 1;
    h = repmat(x,sizeh);
elseif ndims(x)==2 && any(size(x)==1) % Vector x expansion
    if length(x)~=size(dy,1)
        error('diffxy:MismatchedXandY',...
            'length of vector x must match size(y,dim)')
    end
    x = x(:);
    sizeh = size(dy);
    sizeh(1) = 1;
    h = repmat(diff(x),sizeh);
else
    if size(y) ~= size(x)
        error('diffxy:MismatchedXandY',...
            'mismatched sizes of arrays x and y');
    end
    % Permute x as for y, then diff
    h = diff(permute(x,perm),[],1);
end


function a = ijfact1 ( n )

%*****************************************************************************80
%
%% IJFACT1 returns the IJFACT1 matrix.
%
%  Formula:
%
%    A(I,J) = (I+J)!
%
%  Example:
%
%    N = 4
%
%     2   6   24   120
%     6  24  120   720
%    24 120  720  5040
%   120 720 5040 40320
%
%  Properties:
%
%    A is symmetric: A' = A.
%
%    Because A is symmetric, it is normal.
%
%    Because A is normal, it is diagonalizable.
%
%    A is a Hankel matrix: constant along anti-diagonals.
%
%    A is integral: int ( A ) = A.
%
%    The family of matrices is nested as a function of N.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 October 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    MJC Gover,
%    The explicit inverse of factorial Hankel matrices,
%    Department of Mathematics, University of Bradford, 1993.
%
%  Parameters:
%
%    Input, integer N, the order of the matrix.
%
%    Output, real A(N,N), the matrix.
%
  a = zeros ( n, n );

  fact = 1;

  for k = 2 : 2 * n

    fact = fact * k;
    ilo = max ( 1, k - n );
    ihi = min ( n, k - 1 );

    for i = ilo : ihi
      a(i,k-i) = fact;
    end

  end

  return
end


function lmax = lebesgue_constant ( n, x, xfun )

%*****************************************************************************80
%
%% LEBESGUE_CONSTANT estimates the Lebesgue constant for a set of points.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    17 January 2014
%
%  Author:
%
%    John Burkardt.
%
%  Parameters:
%
%    Jean-Paul Berrut, Lloyd Trefethen,
%    Barycentric Lagrange Interpolation,
%    SIAM Review,
%    Volume 46, Number 3, September 2004, pages 501-517.
%
%  Parameters:
%
%    Input, integer N, the number of interpolation points.
%
%    Input, real X(N), the interpolation points.
%
%    Input, real XFUN(*), the evaluation points.
%
%    Output, real LMAX, an estimate of the Lebesgue constant for the points.
%
  lfun = lebesgue_function ( n, x, xfun );

  lmax = max ( lfun );

  return
end


function [A xy] = wheel_graph(n)
% WHEEL_GRAPH Construct a wheel graph of order n
%
% The wheel graph is a cycle graph of order n-1 along with an additional
% vertex that connects all the remaining vertices.  (Run the example and it
% will be extremely clear if you are still confused.)
%
% [A xy] = wheel_graph(n) returns the adjacency matrix for the wheel graph
% of order n.  The matrix xy stores two-dimensional coordinates for each
% vertex.
%
% Example:
%   [A xy] = wheel_graph(10);
%   gplot(A,xy);
%
% See also CYCLE_GRAPH, STAR_GRAPH

% David Gleich
% Copyright, Stanford University, 2007-2008

%% History
%  2007-09-29: Changed output to double, fixed output for i=0,1
%%

if n>1
    i = 1:(n-1);
    j = [i(2:end) i(1)];
    i = [i i];
    j = [j n*ones(1,n-1)];
    A = sparse(i,j,1,n,n);
    A = A|A';
    A = double(A);
else
    i=[];
    A = sparse(n,n);
end

i = i(1:end/2);
if n>0
    xy = [ [cos(2*pi*(i./(n-1))) 0]' [sin(2*pi*(i./(n-1))) 0]' ];
else
    xy = zeros(0,2);
end