%% Implementation of Decision-Based Algorithm for Removal of High-Density
%% Impulse Noises
%% Base Paper : "A New Fast and Efficient Decision-Based Algorithm for
%  Removal of High-Density Impulse Noises", IEEE Sigmal Pricessing Letter,
%  Vol. 14,No. 3, Mar 2007.
%% Function Y = DBAIN(x)
%% input    x = Given an Image
%%
%%  Example: Y = DBAIN(x);
%%      Posted date   : 23 - 10 - 2008
%%      Modified date :
%%
%% Developed By : K.Kannan (kannan.keizer@gmail.com)
%%                & Jeny Rajan (jenyrajan@gmail.com)
%%                  Medical Imaging Research Group (MIRG), NeST,
%%                  Trivandrum.
%%
%% Decision-Based Algorithm for Removal of High-Density Impulse Noises
function Y = DBA(x)

Y = double(x);
[R C] = size(x);
%% Implementation
for i = 2:R-1
    for j = 2:C-1
        clear tmp;
        tmp = Y(i-1:i+1,j-1:j+1);
        flg = 0;
        S = sort(tmp(:));
        if Y(i,j) == 0 || Y(i,j) == 255
            flg = 1;
        end
        if flg == 0 % if the Pixel is uncorrupted.
            if S(1) < Y(i,j) && Y(i,j) < S(5) && 0 < S(1) && S(9) < 255 % The
                % P(X,Y) is an uncorrupted pixel if  Pmin < P(X,Y) < Pmax,
                % Pmin > 0 and Pmax < 255; the pixel being processed is
                % left unchanged. Otherwise, P(X,Y) is a corrupted pixel.
                Y(i,j) = Y(i,j);
            end
        else % if the Pixel is corrupted.
            if S(1) < S(5) && S(5) < S(9) && 0 < S(5) && S(5) < 255 % If P(X,Y)
                % is a corrupted pixel, it is replaced by its median value
                % if Pmin < Pmed < Pmax and 0 < Pmed < 255.
                Y(i,j) = S(5);
            end
            if S(1) >= S(5) || S(5) >= S(9) || S(5) == 255 && S(5) == 0
                % If Pmin < Pmed < Pmax  is not satisfied or 255 < Pmed = 0,
                % then is a noisy pixel. In this case, the P(X,Y) is replaced
                % by the value of neighborhood pixel value.
                Y(i,j) = Y(i,j-1);
            end
        end
    end
end
%% Border Correction
Y(1,:) = Y(2,:);
Y(R,:) = Y(R-1,:);
Y(:,1) = Y(:,2);
Y(:,C) = Y(:,C-1);


%% adjacentdircount
% Below is a demonstration of the features of the |adjacentdircount| function

%% Syntax
% |[Lc]=adjacentdircount(L,n);|

%% Description
% The |adjacentdircount| function calculates the number of adjacent entries
% of an input logic array allong a specified direction.

%% Examples

%%
clear; close all; clc;

%%
% Plot settings
fontSize=10;

%% Example: Using |adjacentdircount| to compute "connectivity"
% The |adjacentdircount| function computes the number of adjacent elements
% in the input array that have the value 1. As such it computes a type of
% connectivity or "thickness" of structures in the logic arrays allong a
% certain dimension.

%%
% Lets consider the following array:

L=[0 1 1 0 0 1;...
   0 0 1 0 0 1;...
   1 0 0 1 1 1]; %A logic array or an array containing ones

%%
% Now view the output of the |adjacentdircount| function for n=1:
n=1; %Row direction (i.e. thickness orthogonal to rows)
[Lc]=adjacentdircount(L,n);
Lc

%%
% and similarly for for n=2:
n=2; %Column direction (i.e. thickness orthogonal to columns)
[Lc]=adjacentdircount(L,n);
Lc

%% Example: Use for 3D arrays
% Create a 3D example array, here L is copied upside down into a second
% "slice" and again for the third slice.
L(:,:,2)=flipud(L);
L(:,:,3)=flipud(L(:,:,1));

%%
%
n=3; %Slice direction (i.e. thickness orthogonal to slices)
[Lc]=adjacentdircount(L,n);
Lc

%% Example: Studying object line feature thickness

% Simulating a striped image in 3D
np=45;
[X,Y,Z]=meshgrid(linspace(-5*pi,5*pi,np));
R=sqrt(X.^2+Y.^2+Z.^2); %Radii
M=sin(R);

%%
% First consider the mid-slice for 2D analysis
midInd=round(size(M,3)/2);
m=M(:,:,midInd);

%%
% Convert to a logic array for thickness analysis
L=m>0;

%%
% Now use |adjacentdircount| to compute "connectivity" allong first and
% second dimensions

[Lc1]=adjacentdircount(L,1); %1st dim
[Lc2]=adjacentdircount(L,2); %1st dim

%%
% Plotting the results
hf=cFigure;
hold on;
subplot(1,3,1);
imagesc(L);
colormap gjet; colorbar;
axis equal; axis tight;
set(gca,'FontSize',fontSize);

subplot(1,3,2);
imagesc(Lc1);
colormap gjet; colorbar;
axis equal; axis tight;
set(gca,'FontSize',fontSize);

subplot(1,3,3);
imagesc(Lc2);
colormap gjet; colorbar;
axis equal; axis tight;
set(gca,'FontSize',fontSize);

drawnow;

%%
% Now lets expand to 3D analysis
L=M>0;
[Lc1]=adjacentdircount(L,1); %1st dim
[Lc2]=adjacentdircount(L,2); %1st dim
[Lc3]=adjacentdircount(L,3); %1st dim

%Construct logic array setting voxels to display using |ind2patch| function
logicPatch=L; %Initialise as L
logicPatch(:,:,midInd:end)=0; %Crop off half to visualize interior

[F,V,C]=ind2patch(logicPatch,L,'vb');
[F1,V1,C1]=ind2patch(logicPatch,Lc1,'vb');
[F2,V2,C2]=ind2patch(logicPatch,Lc2,'vb');
[F3,V3,C3]=ind2patch(logicPatch,Lc3,'vb');

cFigure;
subplot(2,2,1);
xlabel('J');ylabel('I'); zlabel('K'); hold on;
patch('Faces',F,'Vertices',V,'FaceColor','flat','CData',C,'EdgeColor','k');
axis equal; view(3); axis tight; axis vis3d; grid off;
colormap gjet; colorbar;
set(gca,'FontSize',fontSize);

subplot(2,2,2);
xlabel('J');ylabel('I'); zlabel('K'); hold on;
patch('Faces',F1,'Vertices',V1,'FaceColor','flat','CData',C1,'EdgeColor','k');
axis equal; view(3); axis tight; axis vis3d; grid off;
colormap gjet; colorbar;
set(gca,'FontSize',fontSize);

subplot(2,2,3);
xlabel('J');ylabel('I'); zlabel('K'); hold on;
patch('Faces',F2,'Vertices',V2,'FaceColor','flat','CData',C2,'EdgeColor','k');
axis equal; view(3); axis tight; axis vis3d; grid off;
colormap gjet; colorbar;
set(gca,'FontSize',fontSize);

subplot(2,2,4);
xlabel('J');ylabel('I'); zlabel('K'); hold on;
patch('Faces',F3,'Vertices',V3,'FaceColor','flat','CData',C3,'EdgeColor','k');
axis equal; view(3); axis tight; axis vis3d; grid off;
colormap gjet; colorbar;
set(gca,'FontSize',fontSize);

drawnow;

%%
%
% <<gibbVerySmall.gif>>
%
% _*GIBBON*_
% <www.gibboncode.org>
%
% _Kevin Mattheus Moerman_, <gibbon.toolbox@gmail.com>

%%
% _*GIBBON footer text*_
%
% License: <https://github.com/gibbonCode/GIBBON/blob/master/LICENSE>
%
% GIBBON: The Geometry and Image-based Bioengineering add-On. A toolbox for
% image segmentation, image-based modeling, meshing, and finite element
% analysis.
%
% Copyright (C) 2006-2022 Kevin Mattheus Moerman and the GIBBON contributors
%
% 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/>.


function [L,S] = low_rank_matrix_completion(params)
% Given partial observation of a low rank matrix, attempts to complete it.
%
% function [L,S] = low_rank_matrix_completion(A)
%
% This example demonstrates how to use the geometry factory for the
% embedded submanifold of fixed-rank matrices, fixedrankembeddedfactory.
% This geometry is described in the paper
% "Low-rank matrix completion by Riemannian optimization"
% Bart Vandereycken - SIAM Journal on Optimization, 2013.
%
% This can be a starting point for many optimization problems of the form:
%
% minimize f(X) such that rank(X) = k, size(X) = [m, n].
%
% Note that the code is long because it showcases quite a few features of
% Manopt: most of the code is optional.
%
% Input:  None. This example file generate random data.
%
% Output: None.

% This file is part of Manopt and is copyrighted. See the license file.
%
% Main author: Nicolas Boumal, July 15, 2014
% Contributors:
%
% Change log:
%
global P;
global PA;
global problem;

k = 1; % rank
A = params.A;
P = params.Omega;
[m,n] = size(A);
%P = sparse(randi([0 1],m,n));

% Random data generation. First, choose the size of the problem.
% We will complete a matrix of size mxn of rank k:
%m = 200;
%n = 500;
%k = 10;
% Generate a random mxn matrix A of rank k
%L = randn(m, k);
%R = randn(n, k);
%A = L*R';
% Generate a random mask for observed entries: P(i, j) = 1 if the entry
% (i, j) of A is observed, and 0 otherwise.
%fraction = 4 * k*(m+n-k)/(m*n);
%P = sparse(rand(m, n) <= fraction);
% Hence, we know the nonzero entries in PA:
PA = P.*A;

% Pick the manifold of matrices of size mxn of fixed rank k.
problem.M = fixedrankembeddedfactory(m, n, k);

% Define the problem cost function. The input X is a structure with
% fields U, S, V representing a rank k matrix as U*S*V'.
% f(X) = 1/2 * || P.*(X-A) ||^2
problem.cost = @cost;

% Define the Euclidean gradient of the cost function, that is, the
% gradient of f(X) seen as a standard function of X.
% nabla f(X) = P.*(X-A)
problem.egrad = @egrad;

% This is optional, but it's nice if you have it.
% Define the Euclidean Hessian of the cost at X, along H, where H is
% represented as a tangent vector: a structure with fields Up, Vp, M.
% This is the directional derivative of nabla f(X) at X along Xdot:
% nabla^2 f(X)[Xdot] = P.*Xdot
problem.ehess = @euclidean_hessian;

% Check consistency of the gradient and the Hessian. Useful if you
% adapt this example for a new cost function and you would like to make
% sure there is no mistake.
% warning('off', 'manopt:fixedrankembeddedfactory:exp');
% checkgradient(problem); pause;
% checkhessian(problem); pause;

% Compute an initial guess. Points on the manifold are represented as
% structures with three fields: U, S and V. U and V need to be
% orthonormal, S needs to be diagonal.
[U, S, V] = svds(PA, k);
X0.U = U;
X0.S = S;
X0.V = V;

% Minimize the cost function using Riemannian trust-regions, starting
% from the initial guess X0.
X = trustregions(problem, X0);

% The reconstructed matrix is X, represented as a structure with fields
% U, S and V.
L = X.U*X.S*X.V'; % low-rank
S = A - L; % sparse

fprintf('||X-A||_F = %g\n', norm(L - A, 'fro'));

% Alternatively, we could decide to use a solver such as
% steepestdescent or conjugategradient. These solvers need to solve a
% line-search problem at each iteration. Standard line searches in
% Manopt have generic purpose systems to do this. But for the problem
% at hand, it so happens that we can rather accurately guess how far
% the line-search should look, and it would be a waste to not use that.
% Look up the paper referenced above for the mathematical explanation
% of the code below.
%
% To tell Manopt about this special information, we specify the
% linesearch hint function in the problem structure. Notice that this
% is not the same thing as specifying a linesearch function in the
% options structure.
%
% Both the SD and the CG solvers will detect that we
% specify the hint function below, and they will use an appropriate
% linesearch algorithm by default, as a result. Typically, they will
% try the step t*H first, then if it does not satisfy an Armijo
% criterion, they will decrease t geometrically until satisfaction or
% failure.
%
% Just like the cost, egrad and ehess functions, the linesearch
% function could use a store structure if you like. The present code
% does not use the store structure, which means quite a bit of the
% computations are made redundantly, and as a result a better method
% could appear slower. See the Manopt tutorial about caching when you
% are ready to switch from a proof-of-concept code to an efficient
% code.
%
% The inputs are X (a point on the manifold) and H, a tangent vector at
% X that is assumed to be a descent direction. That is, there exists a
% positive t such that f(Retraction_X(tH)) < f(X). The function below
% is supposed to output a "t" that it is a good "guess" at such a t.
% problem.linesearch = @linesearch_helper;

% Notice that for this solver, the Hessian is not needed.
% [Xcg, xcost, info, options] = conjugategradient(problem, X0);
%
% fprintf('Take a look at the options that CG used:\n');
% disp(options);
% fprintf('And see how many trials were made at each line search call:\n');
% info_ls = [info.linesearch];
% disp([info_ls.costevals]);
%
% fprintf('Try it again without the linesearch helper.\n');

% Remove the linesearch helper from the problem structure.
% problem = rmfield(problem, 'linesearch');
%
% [Xcg, xcost, info, options] = conjugategradient(problem, X0);
%
% fprintf('Take a look at the options that CG used:\n');
% disp(options);
% fprintf('And see how many trials were made at each line search call:\n');
% info_ls = [info.linesearch];
% disp([info_ls.costevals]);

% If the problem has a small enough dimension, we may (for analysis
% purposes) compute the spectrum of the Hessian at a point X. This may
% help in studying the conditioning of a problem. If you don't provide
% the Hessian, Manopt will approximate the Hessian with finite
% differences of the gradient and try to estimate its "spectrum" (it's
% not a proper linear operator). This can give some intuition, but
% should not be relied upon.
% if problem.M.dim() < 100
%   fprintf('Computing the spectrum of the Hessian...');
%   s = hessianspectrum(problem, X);
%   hist(s);
% end

end


classdef constrained_quadratic
% This file defines constrained quadratic problem class
%
% Inputs:
%           Q       a positive definite matrix of size nxn
%           p       a column vector of size n
%           A       a matrix of size nxm
%           b       a column vector of size m
%           G       a matrix of size nxp
%           h       a column vector of size p
%
% Output:
%           Problem     problem instance.
%
%
% The problem of interest is defined as
%
%           min f(x) = 1/2 * x^T * Q * x - p^T * x.
%           s.t.
%           A * x = b, G * x <= h
%
% "w" is the model parameter of size d vector.
%
%
% This file is part of GDLibrary.
%
% Created by H.Kasai on Oct. 22, 2020
% Modified by H.Kasai on Dec. 13, 2022

    properties
        d;
        n;
        name;
        dim;
        samples;
        Q;
        p;
        A;
        b;
        G;
        h;

        prox_flag;

    end

    methods
        function obj = constrained_quadratic(Q, p, A, b, G, h)
            obj.d = length(p);
            obj.n = obj.d;

            obj.name = 'constrained_quadratic';
            obj.dim = obj.d;
            obj.samples = obj.n;
            obj.Q = Q;
            obj.p = p;
            obj.A = A;
            obj.b = b;
            obj.G = G;
            obj.h = h;

            obj.prox_flag = true;
        end

        function v = prox(obj, w, t)
            % project y onto the feasible set Ax <= b, i.e. nearest feasible point x to y
            % minimize 0.5||x-y||^2
            % s.t.     Ax <= b

            % equivalent to
            % min J   = 0.5 x'x - x'y + 0.5 y'y
            % st. Ax <= b

            %n = length(y);
            H = eye(obj.d);
            w0 = w;
            qp_options = optimset('Display','off');
            v = quadprog(H,-w,obj.G,obj.h,[],[],[],[],w0, qp_options);
        end

        function f = cost(obj, x)

            f = 1/2 * x' * obj.Q * x - obj.p' * x;
        end

        function g = grad(obj, x)

            g = obj.Q * x - obj.p;

        end

        function g = full_grad(obj, x)

            g = obj.grad(x);

        end

        function h = hess(obj, x)

            h = obj.Q;

        end

        function h = full_hess(obj, x)

            h = obj.hess(x);

        end
    end

end


%ControlCenter

% compile the mex programming function.
mex SearchCycleNode.c

n=30; % The number of nodes in the tree

CostMatric = rand( n );  % randomly generating a cost matrix
for p=1:n
    CostMatric( p,p ) = 0;
end

% 1. search maximum directed spanning tree by unsymmetrical cost matrix "CostMatric", with specified root node "Root".

Root = 3;    % Root of the tree is predefined ahead .
[MaxTree1,MaxCost1] =  DirectedMaximumSpanningTree( CostMatric,Root )
h = view(biograph( MaxTree1 ));

% As for other provided algorithms, you can look at the code , and change
% the part in the similar way.....cheers!!!


function [res,R,p,sigma,Ms] = TransformK(p,rho,sigma,Ms)
%TRANSFORMK   Transformation res+R+sum(ps) = rho+sum(p)
%
%   [res,R,ps] = TransformK(p,rho)
%
%Input vector p may be single or double precision.
%
%Implements Algorithm 6.2 from
%  S.M. Rump, T. Ogita, S. Oishi: Accurate Floating-point Summation II:
%    Sign, K-fold Faithful and Rounding to Nearest, Siam J. Sci. Comput.,
%    31(2):1269-1302, 2008.
%Requires (4m+3)n flops for m executions of repeat-until loop if
%  sigma,Ms not given, otherwise (4m+1)n flops.
%
%Reference implementation! Slow due to interpretation!
%

% written  03/03/07     S.M. Rump
%

  if nargin==4                          % sigma and Ms already known
    kPhi = 0;
    [tau1,tau2,p,sigma,Ms] = Transform(p,rho,kPhi,sigma,Ms);
  else                                  % standard call
    [tau1,tau2,p,sigma,Ms] = Transform(p,rho);
  end
  res = tau1 + ( tau2 + sum(p) );
  R = tau2 - ( res - tau1 );


function [ iou ] = IOU( xi, X )
%IOU Intersection over union similarity measure for two bounding boxes.
%   Each sample must be composed of x = [ULx ULy BRx BRy]

    % Check area on xi
    xi_height = (xi(4) - xi(2) + 1);
    xi_width = (xi(3) - xi(1) + 1);
    xi_area = xi_height * xi_width;

    nSamples = size(X,1);
    iou = zeros(nSamples, 1);
    for j = 1:nSamples

        xj = X(j,:);

        % Check area on xj
        xj_height = (xj(4) - xj(2) + 1);
        xj_width = (xj(3) - xj(1) + 1);
        xj_area = xj_height * xj_width;

        % Check intersection
        count_intersect = rectint([xi(2), xi(1), xi_height, xi_width], [xj(2), xj(1), xj_height, xj_width]);

        % Calculate overlap score (intersection over union)
        iou(j) = count_intersect / (xi_area + xj_area - count_intersect);
    end

end


function test_int_2d_test02 ( )

%*****************************************************************************80
%
%% TEST_INT_2D_TEST02 applies a product of composite midpoint rules.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 July 2010
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST_INT_2D_TEST02\n' );
  fprintf ( 1, '  Apply a product of composite midpoint rules.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Repeatedly multiply the number of points by 16.\n' );

  problem_num = p00_problem_num ( );

  fprintf ( 1, '\n' );
  fprintf ( 1,'   Problem      Points      Approx          Error\n' );

  for problem = 1 : problem_num

    fprintf ( 1, '\n' );

    nx = 1;
    ny = 1;

    for i = 1 : 12

      n = nx * ny;

      x = zeros ( 2, n );

      [ a, b ] = p00_lim ( problem );

      k = 0;

      for ix = 1 : nx

        xval = ( ( 2 * nx - 2 * ix + 1 ) * a(1)   ...
               + (          2 * ix - 1 ) * b(1) ) ...
               / ( 2 * nx              );

        for iy = 1 : ny

          yval = ( ( 2 * ny - 2 * iy + 1 ) * a(2)   ...
                 + (          2 * iy - 1 ) * b(2) ) ...
                 / ( 2 * ny              );

          k = k + 1;
          x(1,k) = xval;
          x(2,k) = yval;

        end

      end

      volume = prod ( b(1:2) - a(1:2) );

      fx = p00_fun ( problem, n, x );

      quad = volume * sum ( fx(1:n) ) / n;

      exact = p00_exact ( problem );

      error = abs ( quad - exact );

      fprintf ( 1, '  %8d  %10d  %14e  %14e\n', ...
        problem, n, quad, error );

      nx = nx * 2;
      ny = ny * 2;

    end

    fprintf ( 1, '  %8d       Exact  %14e\n', ...
      problem, exact );

  end

  return
end


function fx = exp_cordic ( x, n )

%*****************************************************************************80
%
%% EXP_CORDIC evaluates the exponential function using the CORDIC method.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 June 2007
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Frederick Ruckdeschel,
%    BASIC Scientific Subroutines,
%    Volume II,
%    McGraw-Hill, 1980,
%    ISBN: 0-07-054202-3,
%    LC: QA76.95.R82.
%
%    Pitts Jarvis,
%    Implementing CORDIC Algorithms,
%    Dr Dobb's Journal,
%    October 1990.
%
%  Parameters:
%
%    Input, real X, the argument.
%
%    Input, integer N, the number of steps to take.
%
%    Output, real FX, the exponential of X.
%
%  Local Parameters:
%
%    Local, real A(1:25) = exp ( (1/2)^(1:25) );
%
  a_length = 25;

  a = [ ...
    1.648721270700128, ...
    1.284025416687742, ...
    1.133148453066826, ...
    1.064494458917859, ...
    1.031743407499103, ...
    1.015747708586686, ...
    1.007843097206488, ...
    1.003913889338348, ...
    1.001955033591003, ...
    1.000977039492417, ...
    1.000488400478694, ...
    1.000244170429748, ...
    1.000122077763384, ...
    1.000061037018933, ...
    1.000030518043791, ...
    1.0000152589054785, ...
    1.0000076294236351, ...
    1.0000038147045416, ...
    1.0000019073504518, ...
    1.0000009536747712, ...
    1.0000004768372719, ...
    1.0000002384186075, ...
    1.0000001192092967, ...
    1.0000000596046466, ...
    1.0000000298023228 ];
  e = 2.718281828459045;

  x_int = floor ( x );
%
%  Determine the weights.
%
  poweroftwo = 0.5;
  z = x - x_int;

  for i = 1 : n
    w(i) = 0.0;
    if ( poweroftwo < z )
      w(i) = 1.0;
      z = z - poweroftwo;
    end
    poweroftwo = poweroftwo / 2.0;
  end
%
%  Calculate products.
%
  fx = 1.0;

  for i = 1 : n

    if ( i <= a_length )
      ai = a(i);
    else
      ai = 1.0 + ( ai - 1.0 ) / 2.0;
    end

    if ( 0.0 < w(i) )
      fx = fx * ai;
    end

  end
%
%  Perform residual multiplication.
%
  fx = fx             ...
    * ( 1.0 + z       ...
    * ( 1.0 + z / 2.0 ...
    * ( 1.0 + z / 3.0 ...
    * ( 1.0 + z / 4.0 ))));
%
%  Account for factor EXP(X_INT).
%
  if ( x_int < 0 )

    for i = 1 : -x_int
      fx = fx / e;
    end

  else

    for i = 1 : x_int
      fx = fx * e;
    end

  end

  return
end


function newpt=rotatevec3d(pt,v1,u1,p0)
%
% newpt=rotatevec3d(pt,v1,u1,p0)
%
% rotate 3D points from one Cartesian coordinate system to another
%
% author: Qianqian Fang, <fangq at nmr.mgh.harvard.edu>
%
% input:
%   pt: 3D points defined in a standard Cartesian system where a unitary
%       z-vector is (0,0,1), 3 columns for x, y and z
%   v1: the unitary z-vector for the target coordinate system
%   u1: the unitary z-vector for the source coordinate system, if ignored,
%       u1=(0,0,1)
%   p0: offset of the new coordinate system, if ignored, p0=(0,0,0)
%
% output:
%   newpt: the transformed 3D points
%
% -- this function is part of iso2mesh toolbox (http://iso2mesh.sf.net)
%

if(nargin<2)
    error('you must give at least pt and v1');
end
if(nargin==2)
    u1=[0,0,1];
end
if(nargin<=3)
    p0=[0,0,0];
end

u1=u1/norm(u1);
v1=v1/norm(v1);

[R,s]=rotmat2vec(u1,v1);
newpt=(R*pt'*s)';

if(nargin>3)
  p0=p0(:)';
  newpt=newpt+repmat(p0,size(newpt,1),1);
end


function [out1, out2] = gpS00(X, P);
%%function [out1, out2] = gpS00(X, {input, target, test});

% gpS00: Gaussian process regression with "squared negative exponential"
% covariance function and independent Gaussian noise model. Two modes are
% possible: training and prediction: if no test data are given, the function
% returns minus the log likelihood and its partial derivatives with respect to
% the hyperparameters; this mode is used to fit the hyperparameters. If test
% data are given, then (marginal) Gaussian predictions are computed, whose mean
% and (noise free) variance are returned.
%
% usage: [fX dfX] = gpS00(X, input, target)
%    or: [mu S2]  = gpS00(X, input, target, test)
%
% where:
%
%   X      is a (column) vector (of size D+2) of hyperparameters
%   input  is a n by D matrix of training inputs
%   target is a (column) vector (of size n) of targets
%   test   is a nn by D matrix of test inputs
%   fX     is the returned value of minus log likelihood
%   dfX    is a (column) vector (of size D+2) of partial derivatives
%            of minus the log likelihood wrt each of the hyperparameters
%   mu     is a (column) vector (of size nn) of prediced means
%   S2     is a (column) vector (of size nn) of predicted variances
%
% where D is the dimension of the input. The form of the covariance function is
%
% C(x^p,x^q) = v^2 * exp[-(x^p - x^q)'*inv(P)*(x^p - x^q)/2]
%            + u^2 * delta_{p,q}
%
% where the first term is the squared negative exponential and the second term
% with the kronecker delta is the noise contribution. The P matrix is diagonal
% with "Automatic Relevance Determination" (ARD) or "input length scale"
% parameters w_1^2,...,w_D^2; The hyperparameter v is the "signal std dev" and
% u is the "noise std dev". All hyperparameters are collected in the vector X
% as follows:
%
% X = [ log(w_1)
%       log(w_2)
%        .
%       log(w_D)
%       log(v)
%       log(u) ]
%
% Note: the reason why the log of the parameters are used in X is that this
% often leads to a better conditioned (and unconstrained) optimization problem
% than using the raw hyperparameters themselves.
%
% This function can conveniently be used with the "minimize" function to train
% a Gaussian process:
%
% [X, fX, i] = minimize(X, 'gpS00', length, input, target)
%
% See also: minimize, hybrid
%
% (C) Copyright 1999 - 2003, Carl Edward Rasmussen (2003-08-08).

input=P{1};
target=P{2};
if length(P) == 3
	test=P{3};
	testmode=1;
else
	testmode=0;
end

[n, D] = size(input);         % number of examples and dimension of input space
input = input ./ repmat(exp(X(1:D))',n,1);

% first, we write out the covariance matrix Q

warning off;

Q = zeros(n,n);
for d = 1:D
  Q = Q + (repmat(input(:,d),1,n)-repmat(input(:,d)',n,1)).^2;
end
Q = exp(2*X(D+1))*exp(-0.5*Q);

if ~testmode   % if no test cases, we compute the negative log likelihood ...

  W = (Q+exp(2*X(D+2))*eye(n))\eye(n);               % W is inv (Q plus noise term)
  invQt = W*target;                               % don't compute determinant..
  [C,flag]=chol(Q+exp(2*X(D+2))*eye(n));
  logdetQ = 2*sum(log(diag(C)));        % ..directly
  out1 = 0.5*logdetQ + 0.5*target'*invQt + 0.5*n*log(2*pi);

  % ... and its partial derivatives

  out2 = zeros(D+2,1);                  % set the size of the derivative vector
  W = W-invQt*invQt';
  Q = W.*Q;
  for d = 1:D
    out2(d) = ...
            sum(sum(Q.*(repmat(input(:,d),1,n)-repmat(input(:,d)',n,1)).^2))/2;
  end
  out2(D+1) = sum(sum(Q));
  out2(D+2) = trace(W)*exp(2*X(D+2));

else                    % ... otherwise compute (marginal) test predictions ...

  [nn, D] = size(test);     % number of test cases and dimension of input space
  test = test ./ repmat(exp(X(1:D))',nn,1);

  a = zeros(n, nn);    % compute the covariance between training and test cases
  for d = 1:D
    a = a + (repmat(input(:,d),1,nn)-repmat(test(:,d)',n,1)).^2;
  end
  a = exp(2*X(D+1))*exp(-0.5*a);

  % ... write out the desired terms

  if nargout == 1
    out1 = a'*((Q+exp(2*X(D+2))*eye(n))\target);              % predicted means
  else
    invQ = inv(Q+exp(2*X(D+2))*eye(n));
    out1 = a'*(invQ*target);                                  % predicted means
    out2 = exp(2*X(D+1)) - sum(a.*(invQ*a),1)'; % predicted noise-free variance
  end

end


clear all; close all; clc

n=100; L=4;
x=linspace(0,L,n);
f=(x.^2).';  % parabola with 100 data points

M=20;  % polynomical degree
for j=1:M
  phi(:,j)=(x.').^(j-1);  % build matrix A
end

for j=1:4
    fn=(x.^2+0.1*randn(1,n)).';
    an=pinv(phi)*fn; fna=phi*an;  % least-square fit
    En=norm(f-fna)/norm(f);
    subplot(4,2,4+j),bar(an,'FaceColor',[.6 .6 .6],'EdgeColor','k')
end

subplot(2,1,1), plot(x,f,'k'), hold on

%% different regressions
subplot(2,1,1)
lambda=0.1; phi2=phi(:,2:end);
for jj=1:100
  f=(x.^2+0.2*randn(1,n)).';
  a1=pinv(phi)*f; f1=phi*a1; E1(jj)=norm(f-f1)/norm(f);
  a2=phi\f; f2=phi*a2; E2(jj)=norm(f-f2)/norm(f);
  [a3,stats]=lasso(phi,f,'Lambda',lambda); f3=phi*a3; E3(jj)=norm(f-f3)/norm(f);
  [a4,stats]=lasso(phi,f,'Lambda',lambda,'Alpha',0.8); f4=phi*a4; E4(jj)=norm(f-f4)/norm(f);
a5=robustfit(phi2,f);f5=phi*a5;E5(jj)=norm(f-f5)/norm(f);
a6=ridge(f,phi2,0.5,0);f6=phi*a6;E6(jj)=norm(f-f6)/norm(f);

  A1(:,jj)=a1;A2(:,jj)=a2;A3(:,jj)=a3;A4(:,jj)=a4;A5(:,jj)=a5;A6(:,jj)=a6;
  plot(x,f), hold on
end
Err=[E1; E2; E3; E4; E5; E6];
Err2=[E1; E2; E3; E4; E5];

figure(2)
subplot(3,2,1), boxplot(A1.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})
subplot(3,2,2), boxplot(A2.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})
subplot(3,2,3), boxplot(A3.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})
subplot(3,2,4), boxplot(A4.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})
subplot(3,2,5), boxplot(A5.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})
subplot(3,2,6), boxplot(A6.'), set(gca,'Xtick',1:20,'Xticklabel',{'1','','','','5','','','','','10','','','','','15','','','','','20'})

figure(3)
subplot(3,3,1), boxplot(Err.'), axis([0 7 0.02 0.07])

%%
clear phi
M=10;
En=zeros(100,M);
for jj=1:M
  for j=1:jj
    phi(:,j)=(x.').^(j-1);
  end
  f=(x.^2).';
  for j=1:100
    fn=(x.^2+0.1*randn(1,n)).';
    an=pinv(phi)*fn; fna=phi*an;
    En(j,jj)=norm(f-fna)/norm(f);
  end
end

figure(3)
subplot(3,3,2)
boxplot(En)

subplot(3,3,3)
boxplot(En), axis([0.5 10.5 0 0.008])


function tetrahedron_unit_monomial_test ( degree_max )

%*****************************************************************************80
%
%% TETRAHEDRON_UNIT_MONOMIAL_TEST tests TETRAHEDRON_UNIT_MONOMIAL.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 April 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer DEGREE_MAX, the maximum total degree of the
%    monomials to check.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TETRAHEDRON_UNIT_MONOMIAL_TEST\n' );
  fprintf ( 1, '  For the unit tetrahedron,\n' );
  fprintf ( 1, '  TETRAHEDRON_UNIT_MONOMIAL returns the exact value of the\n' );
  fprintf ( 1, '  integral of X^ALPHA Y^BETA Z^GAMMA\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Volume = %f\n', tetrahedron_unit_volume ( ) );
  fprintf ( 1, '\n' );
  fprintf ( 1, '     ALPHA      BETA     GAMMA      INTEGRAL\n' );
  fprintf ( 1, '\n' );

  for alpha = 0 : degree_max
    expon(1) = alpha;
    for beta = 0 : degree_max - alpha
      expon(2) = beta;
      for gamma = 0 : degree_max - alpha - beta
        expon(3) = gamma;
        value = tetrahedron_unit_monomial ( expon );
        fprintf ( 1, '  %8d  %8d  %8d  %14.6e\n', expon(1:3), value );
      end
    end
  end

  return
end


function C = ProdKL(A,B,K,L)
%PRODKL       Matrix product in approximately K-fold precision stored in L results
%
%   C = ProdKL(A,B,K,L)
%
% Input A or B or both may be cell arrays, 1 <= L <= K.
% Output C is cell array iff L>1, default is L=1.
% Simple application of SumKL. All input must be real.
% Relative error of the result is of order  eps^L + eps^K cond(product) , see
%   S.M. Rump: Inversion of extremely ill-conditioned matrices in floating-point,
%      Japan J. Indust. Appl. Math. (JJIAM), 26:249-277, 2009.
%
%Reference implementation! Slow due to interpretation!
%

% written  02/17/08     S.M. Rump
% modified 05/09/09     S.M. Rump  rounding to nearest, default L=1
%

  e = 1e-30;
  if 1+e==1-e                           % fast check for rounding to nearest
    rndold = 0;
  else
    rndold = getround;
    setround(0)
  end

  if nargin==3
    L = 1;
  end

  if iscell(A)              % input A cell array
    n = size(A{1},1);
    lenA = length(A);
    AA = zeros(n,lenA*n);
    for i=1:lenA
      AA(:,(i-1)*n+1:i*n) = A{i};
    end
    if iscell(B)            % both A and B cell arrays
      lenB = length(B);
      m = lenA*n;
      AAA = zeros(n,lenB*m);
      BBB = zeros(lenB*m,n);
      for i=1:lenB
        AAA(:,(i-1)*m+1:i*m) = AA;
        BBB((i-1)*m+1:i*m,:) = repmat(B{i},lenA,1);
      end
      A = AAA;
      B = BBB;
    else
      A = AA;
      B = repmat(B,lenA,1);
    end
  else
    n = size(A,1);
  end
  if iscell(B)              % input B cell array
    lenB = length(B);
    A = repmat(A,1,lenB);
    BB = zeros(lenB*n,n);
    for i=1:lenB
      BB((i-1)*n+1:i*n,:) = B{i};
    end
    B = BB;
  end
  if L==1
    C = zeros(n);
  else
    for i=1:L
      C{i} = zeros(n);
    end
  end
  for i=1:n
    for j=1:n
      [x,y] = TwoProduct(A(i,:),B(:,j)');
      res = SumKL([x y],K,L);
      if L==1
        C(i,j) = res;
      else
        for k=1:L
          C{k}(i,j) = res(k);
        end
      end
    end
  end

  if rndold
    setround(rndold)
  end


function  A = umADEIGSwhole(Ncell,p)

Dhat = zeros(p+1);
for n=0:p
    for m=n+1:2:p
        Dhat(n+1,m+1) =  (2*n+1);
    end
end

% M = int_{-1}^{1} L_n(x)*L_m(x) dx (note dx=1 assumed)
M = diag(2./(2*(0:p)+1));

% D_nm = int_{-1}^{1}  L_n(x)*L_m(x)*dx
D = M*Dhat;

% F_nm = L_n(-1)*L_m(-1)
F = (-1).^[0:p]'*(-1).^[0:p];

% G_nm = -L_n(-1)*L_m(1)
G = -(-1).^[0:p]'*ones(1,p+1);

% build entire matrix
Ntotal = Ncell*(p+1);
A    = zeros(Ntotal);

for cell = 1:Ncell
    id1 = ((cell-1)*(p+1)+1):cell*(p+1);
    A(id1,id1) = (1/2)*M\(D+F);

    if(cell~=1)
        id2 = id1-(p+1);
    else
        id2 = id1+(Ncell-1)*(p+1);
    end

    A(id1, id2) = (1/2)*M\G;
end

eA = eig(A);

plot(-real(eA), -imag(eA), 'bo');


function [rf, vf] = twobody2 (mu, tau, ri, vi)

% solve the two body initial value problem

% Shepperd's method

% input

%  mu  = gravitational constant (km**3/sec**2)
%  tau = propagation time interval (seconds)
%  ri  = initial eci position vector (kilometers)
%  vi  = initial eci velocity vector (kilometers/second)

% output

%  rf = final eci position vector (kilometers)
%  vf = final eci velocity vector (kilometers/second)

% Orbital Mechanics with MATLAB

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

tolerance = 1.0d-12;

u = 0;

imax = 20;

umax = +realmax;

umin = -realmax;

orbits = 0;

tdesired = tau;

threshold = tolerance * abs (tdesired);

r0 = norm(ri);

n0 = dot(ri, vi);

beta = 2 * (mu / r0) - dot(vi, vi);

if (beta ~= 0)
    umax = +1 / sqrt(abs(beta));

    umin = -1 / sqrt(abs(beta));
end

if (beta > 0)
    orbits = beta * tau - 2 * n0;

    orbits = 1 + (orbits * sqrt(beta)) / (pi * mu);

    orbits = floor (orbits / 2);
end

for i = 1:1:imax

    q = beta * u * u;

    q = q / (1 + q);

    n =  0;

    r = 1;

    l = 1;

    s = 1;

    d = 3;

    gcf = 1;

    k = -5;

    gold = 0;

    while (gcf ~= gold)

        k = -k;

        l = l + 2;

        d = d + 4 * l;

        n = n + (1 + k) * l;

        r = d / (d - n * r * q);

        s = (r - 1) * s;

        gold = gcf;

        gcf  = gold + s;

    end

    h0 = 1 - 2 * q;

    h1 = 2 * u * (1 - q);

    u0 = 2 * h0 * h0 - 1;

    u1 = 2 * h0 * h1;

    u2 = 2 * h1 * h1;

    u3 = 2 * h1 * u2 * gcf / 3;

    if (orbits ~= 0)
        u3 = u3 + 2 * pi * orbits / (beta * sqrt(beta));
    end

    r1 = r0 * u0 + n0 * u1 + mu * u2;

    dt = r0 * u1 + n0 * u2 + mu * u3;

    slope = 4 * r1 / (1 + beta * u * u);

    terror = tdesired - dt;

    if (abs (terror) < threshold)
        break;
    end;

    if ((i > 1) && (u  ==  uold) )
        break;
    end

    if ((i > 1) && (dt == dtold) )
        break;
    end

    uold  = u;

    dtold = dt;

    ustep = terror / slope;

    if (ustep > 0)
        umin = u;

        u = u + ustep;

        if (u > umax)
            u = (umin + umax) / 2;
        end
    else
        umax = u;

        u = u + ustep;

        if (u < umin)
            u = (umin + umax) / 2;
        end
    end

    if (i == imax)
        fprintf('\n\nmax iterations in twobody2 function');
    end

end

usaved = u;

f = 1.0 - (mu / r0) * u2;

gg = 1.0 - (mu / r1) * u2;

g  =  r0 * u1 + n0 * u2;

ff = -mu * u1 / (r0 * r1);

% final position and velocity vectors

for i = 1:1:3
    rf(i) = f  * ri(i) + g  * vi(i);

    vf(i) = ff * ri(i) + gg * vi(i);
end


function value = p27_exact ( dim_num )

%*****************************************************************************80
%
%% P27_EXACT returns the exact integral for problem 27.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 March 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer DIM_NUM, the spatial dimension.
%
%    Output, real VALUE, the exact value of the integral.
%
  r = 0.0;
  r = p27_r8 ( 'G', 'R', r );

  c = [];
  c = p27_r8vec ( 'G', 'C', dim_num, c );

  value = 2.0^dim_num * ...
    cos ( 2.0 * pi * r + 0.5 * sum ( c(1:dim_num) ) ) * ...
    prod ( sin ( 0.5 * c(1:dim_num) ) ./ c(1:dim_num ) );

  return
end


function [G,H] = mass_spring_gradient_hessian(V,E,k,U)

  % Compute the gradient and hessian of a mass-spring system defined for (V,E)
  % with the stiffness k and displacement U
  % Inputs:
  %   V  #V by 2 list of rest curve vertex positions
  %   E  #E by 2 list of edge indices
  %   k  scalar spring stiffness parameter
  %   U  #V by 2 list of deformed curve vertex displacements from the rest pose
  % Outputs:
  %   G  #V*2 list of gradient vectors per vertex defined at the current deformed position
  %   H  #V*2 by #V*2 hessian matrix defined at the current deformed position

  assert(size(E,2) == 2);
  U = reshape(U,size(V));

  % rest edge lengths
  LV = edge_lengths(V,E);
  LU = edge_lengths(U,E);
  f = k*0.5*sum((LV-LU).^2);

  if nargout==0
    return;
  end

  I = E(:,2);
  J = E(:,1);
  T0 = U(I,:) - U(J,:);
  t1 = normrow(T0);

  GI = ((t1-LV)./t1).*T0;
  GJ = -GI;

  dim = size(V,2);
  G = k*full(sparse([repmat(I,1,dim) repmat(J,1,dim)],repmat(1:dim,size(E,1),2),[GI GJ],size(V,1),dim));
  G = G(:); % to match the dimension: not sure if correct

  if nargout==1
    return;
  end

  % Outer product
  vec = @(X) X(:);
  T2 = T0(:,vec(repmat(1:dim,dim,1))').*T0(:,vec(repmat(1:dim,1,dim))');
  t3 = t1 - LV;

  HIJ = (t3./(t1.^3) - 1./(t1.^2)).*T2 - t3./t1.*(vec(eye(dim))');
  HII = -HIJ;
  HJJ = -HIJ;
  HJI = HIJ;
  n = size(V,1);
  H = sparse(n*dim,n*dim);
  for ii = 1:dim
    for jj = 1:dim
      oi = (ii-1)*dim+jj;
      Hiijj = sparse( ...
        [I I J J],[I J I J],[HII(:,oi) HIJ(:,oi) HJI(:,oi) HJJ(:,oi)],n,n);
      H(((ii-1)*n)+(1:n),((jj-1)*n)+(1:n)) = Hiijj;
    end
  end
  H = k*H;

end


function [ftAllNew,transMdl] = ftTrans_pca(ftAll,maSrc,target,maLabeled,param)
%A baseline to other domain adaptation methods, use PCA or KPCA to extract
% features.
%
% Application scope:
%	+ Any scenario since no domain adaptation is done.
%
% ftAll:	All samples in all domains. n-by-m matrix, n is the number of
%	samples, m is the dimension of features.
% maSrc,target,maLabeled:	useless.
%
% param: Struct of hyper-parameters, please see the first cell of this
%	program ("default parameters") for details. You can set parameter p to
%	x by setting param.p = x. For parameters that are not set, default
%	values will be used.
%
% ftAllNew:	All samples in the learned subspace.
% transMdl:	A struct containing the model, transMdl.W is the projection
%	matrix.
%
% The ftProc_(k)pca_tr function is a part of the PRTools toolbox.
% if kerName is set in param, use KPCA; else, use original linear PCA.
%
% Copyright 2016 Ke YAN, Tsinghua Univ. http://yanke23.com , xjed09@gmail.com

%% default parameters
pcaCoef = 0; % see ftProc_pca_tr
kerName = 'poly'; % see ftProc_kpca_tr
kerSigma = 1;
degree = 2;

defParam

%% compute and project the samples
if ~isfield(param,'kerName')
	[ftAllNew,pcaModel] = ftProc_pca_tr(ftAll,[],struct('pcaCoef',pcaCoef));
else
	[ftAllNew,pcaModel] = ftProc_kpca_tr(ftAll,[],struct('pcaCoef',pcaCoef,...
		'kernel',kerName,'kerSigma',kerSigma,'degree',degree));
end

transMdl = pcaModel;

end


function net = glm(nin, nout, outfunc, prior, beta)
%GLM	Create a generalized linear model.
%
%	Description
%
%	NET = GLM(NIN, NOUT, FUNC) takes the number of inputs and outputs for
%	a generalized linear model, together with a string FUNC which
%	specifies the output unit activation function, and returns a data
%	structure NET. The weights are drawn from a zero mean, isotropic
%	Gaussian, with variance scaled by the fan-in of the output units.
%	This makes use of the Matlab function RANDN and so the seed for the
%	random weight initialization can be  set using RANDN('STATE', S)
%	where S is the seed value. The optional argument ALPHA sets the
%	inverse variance for the weight initialization.
%
%	The fields in NET are
%	  type = 'glm'
%	  nin = number of inputs
%	  nout = number of outputs
%	  nwts = total number of weights and biases
%	  actfn = string describing the output unit activation function:
%	      'linear'
%	      'logistic'
%	      'softmax'
%	  w1 = first-layer weight matrix
%	  b1 = first-layer bias vector
%
%	NET = GLM(NIN, NOUT, FUNC, PRIOR), in which PRIOR is a scalar, allows
%	the field  NET.ALPHA in the data structure NET to be set,
%	corresponding  to a zero-mean isotropic Gaussian prior with inverse
%	variance with value PRIOR. Alternatively, PRIOR can consist of a data
%	structure with fields ALPHA and INDEX, allowing individual Gaussian
%	priors to be set over groups of weights in the network. Here ALPHA is
%	a column vector in which each element corresponds to a  separate
%	group of weights, which need not be mutually exclusive.  The
%	membership of the groups is defined by the matrix INDEX in which the
%	columns correspond to the elements of ALPHA. Each column has one
%	element for each weight in the matrix, in the order defined by the
%	function GLMPAK, and each element is 1 or 0 according to whether the
%	weight is a member of the corresponding group or not.
%
%	NET = GLM(NIN, NOUT, FUNC, PRIOR, BETA) also sets the  additional
%	field NET.BETA in the data structure NET, where beta corresponds to
%	the inverse noise variance.
%
%	See also
%	GLMPAK, GLMUNPAK, GLMFWD, GLMERR, GLMGRAD, GLMTRAIN
%

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

net.type = 'glm';
net.nin = nin;
net.nout = nout;
net.nwts = (nin + 1)*nout;

outtfns = {'linear', 'logistic', 'softmax'};

if sum(strcmp(outfunc, outtfns)) == 0
  error('Undefined activation function. Exiting.');
else
  net.outfn = outfunc;
end

if nargin > 3
  if isstruct(prior)
    net.alpha = prior.alpha;
    net.index = prior.index;
  elseif size(prior) == [1 1]
    net.alpha = prior;
  else
    error('prior must be a scalar or structure');
  end
end

net.w1 = randn(nin, nout)/sqrt(nin + 1);
net.b1 = randn(1, nout)/sqrt(nin + 1);

if nargin == 5
  net.beta = beta;
end


% Nonnegative Matrix Factorization with Quadratic Programming
% The function iptrnr(Y,X,no_iter,lambdaA,rho,eta,epsil_A) returns
% the matrix A for the constrained system of linear equations: AX = Y

function A = iptrnr(Y,X,no_iter,lambdaA,rho,eta,epsil_A)

% INPUTS:
% > Y:        observation matrix [I by K] of mixed signals (images)
% > X:        source component matrix [J by K]
% > no_iter:  number of inner iterations
% > lambdaA:  Tikhonov regularization parameter
% > rho:      auxiliary parameter for defining the log barrier parameter
% > eta:      parameter in stopping rule for iterations
% > epsil_A:  threshold for active-set variables

% OUTPUT:
% > A:        mixing matrix [I by J]

[J,K] = size(X); [I,Ky] = size(Y); M = I*J;

% Initialization
A = ones(I,J);
Q_bar = spalloc(M,M,M*J); Q_tilde = spalloc(M,M,M*J);

B = X*X'; C_bar = X*Y';
Q_bar = kron(speye(I),B); % Hessian of D(Y||AX) with respect to A
Go = (C_bar - B*A'); % Gradient of D(Y||AX) with respect to A^T
At = A';
theta = -(rho/(M))*abs(Go(:)'*At(:)); % initialization for
                                      %log barrier parameter
l = 0;
while l < no_iter % inner iterations

    l = l + 1;
    a = At(:);
    active = find(a < epsil_A); % active set
    inactive = find(a >= epsil_A); % inactive set

    if ~isempty(active)
        a_tilde = a;             a_tilde(active) = [];
        N = length(a_tilde);
        c_tilde = C_bar(:);      c_tilde(active) = [];
        c_tilde = 2*theta*1./a_tilde - c_tilde;
        Q_tilde = Q_bar;
        Q_tilde(:,active) = [];  Q_tilde(active,:) = [];
        Q_tilde = Q_tilde - theta*spdiags(1./a_tilde.^2,0,N,N);
    else
        a_tilde = a;
        Q_tilde = Q_bar - theta*spdiags(1./a.^2,0,M,M) + lambdaA*speye(M);
        c_tilde = 2*theta*(1./a) - C_bar(:);
    end

     [Q,R] = qr(Q_tilde,-c_tilde); % Q-less QR factorization
     z_tilde = R\Q; % Gaussian elimination
     h_tilde = z_tilde - a_tilde;
     beta = min(1, 0.9995*min(a_tilde./abs(h_tilde)));
     a_tilde = a_tilde + beta*h_tilde;

     theta_tilde = theta*(2*(1./a_tilde) - (1./a_tilde.^2).*z_tilde);
     theta = ( theta_tilde'*a_tilde);

     if ~isempty(active)
        an = zeros(M,1);   an(inactive) = a_tilde;   a = an;
     else
        a = a_tilde;
     end

     if abs(theta) < eta*norm(a) % stopping rule
        break
     end
     theta = (rho/sqrt(M))*theta;
     At = reshape(a,J,I);

end
A = At';


function [ x ] = hyperdistance( geo1, geo2 )
%HYPERDISTANCE Calculate hyperdistance between two geometry structures.
%   x = HYPERDISTANCE(geometry1,geometry2) evaluates the hyperdistance
%   between two geometries. The hyperdistance is defined as the root mean
%   square of the displacements of each atom. The returned value is only
%   meaningful if the two geometries have the same lattice vectors. The
%   minimum image convention is used to calculate atomic displacements. See
%   IMPORT_POSCAR for a detailed description of the geometry structure.
%
%   See also IMPORT_POSCAR.

       x = sqrt(sum(sum(((mod(abs(geo2.coords-geo1.coords)+0.5,1)-0.5)*geo1.lattice).^2)));

end


function f = dtlz4a(x)

alpha = 10;

%% g function
sum = 0;
for i = 3:8
sum = sum + (x(:,i)-0.5)^2;
end
g = sum;

%% cost functions
f(:,1) = (1+g)*cos(((x(:,1)^alpha)*pi)/2)*cos(((x(:,2)^alpha)*pi)/2);
f(:,2) = (1+g)*cos(((x(:,1)^alpha)*pi)/2)*sin(((x(:,2)^alpha)*pi)/2);
f(:,3) = (1+g)*sin(((x(:,1)^alpha)*pi)/2);
end


function [] = fseriesdemo(f,b,NN)
% FSERIESDEMO Plots a function f and it's Fourier series approximation.
% FSERIESDEMO(f,b,N) plots the function f and it's N term Fourier series
% approximation from zero to b.  FSERIESDEMO uses the FFT to approximate
% the Trigonometric Fourier Series coefficients.  FSERIESDEMO only works
% for the function from 0 to b.  Input N must be an integer >=2.
% Example:
%
%           f = @(x) sin(x)./x+(cos(x)).^2-exp(x/8)+x.^(x/20);
%           fseriesdemo(f,20,100)  % Approx. f on (0,20) with 100 terms.
%
%
% Author:  Matt Fig
% Contact:  popkenai@yahoo.com

% First some argument checking.
if nargin<3
   error ('Not enough arguments. See help.')
end

if ~isreal(NN) || ~isreal(b) || b<=0 || NN < 2 || floor(NN)~=NN
    error ('2nd and 3rd args must be positive real scalars. See help.')
end

n = 2*NN;
T = b-eps+(b-eps)/(n-2); % Get the appropriate endpoint for fft.
x = linspace(eps,T,n+1); % Use this x in fft.
x(end) = [];   % But not the endpoint.
fun = f(x);  % Get discrete points.
FUNC = fft(fun);  % Call fft
FUNC = [conj(FUNC(NN+1)) FUNC(NN+2:end) FUNC(1:NN+1)]/n; % Shift/scale.
A0 = FUNC(NN+1);   % First cosine term.
AN = 2*real(FUNC(NN+2:end));  % General cosine term.
BN = -2*imag(FUNC(NN+2:end));  % General sine term.

p = app1(x,A0,AN,BN,T);
% Now on to the plotting.
xx = linspace(eps,x(end),b*100);
xx(end) = [];
fun = f(xx);
hand = plot(xx,fun,'r',x,p,'b');
set(hand,'linewidth',2)
grid on;
axis tight;
legend('User Function',[num2str(NN),' Term Approximation'],0)

function answ = app1(x,A0,AN,BN,T)
ii = 1:length(AN);   % The indeces.
lgh = length(x);
[ii x] = meshgrid(ii,x); % Arrays for angles.
AN = repmat(AN,lgh,1);   % Create arrays for approximation.
BN = repmat(BN,lgh,1);
theta = ii.*x.*(2*pi)/T; % The angles.
answ = (sum(AN.*cos(theta)+BN.*sin(theta),2)+A0)'; % the F approximation.


% RANDSAMPLE Random sample, with or without replacement.
%    Y = RANDSAMPLE(N,K) returns Y as a column vector of K values sampled
%    uniformly at random, without replacement, from the integers 1:N.
%
%    Y = RANDSAMPLE(POPULATION,K) returns K values sampled uniformly at random,
%    without replacement, from the values in the vector POPULATION.  Y is a
%    vector of the same type as POPULATION.  NOTE:  When POPULATION is a
%    numeric vector containing only non-negative integer values, and it might
%    have length 1, use
%
%       Y = POPULATION(RANDSAMPLE(LENGTH(POPULATION),K)
%
%    instead of Y = RANDSAMPLE(POPULATION,K).
%
%    Y = RANDSAMPLE(N,K,REPLACE) or RANDSAMPLE(POPULATION,K,REPLACE) returns a
%    sample taken with replacement if REPLACE is true, or without replacement
%    if REPLACE is false (the default).
%
%    Y = RANDSAMPLE(N,K,true,W) or RANDSAMPLE(POPULATION,K,true,W) returns a
%    weighted sample, using positive weights W, taken with replacement.  W is
%    often a vector of probabilities. This function does not support weighted
%    sampling without replacement.
%
%    Y = RANDSAMPLE(S,...) uses the random number stream S for random number
%    generation.  RANDSAMPLE uses the MATLAB default random number stream by
%    default.
%
%    Examples:
%
%    Draw a single value from the integers 1:10.
%       n = 10;
%       x = randsample(n,1);
%
%    Draw a single value from the population 1:n, when n > 1.
%       y = randsample(1:n,1);
%
%    Generate a random sequence of the characters ACGT, with
%    replacement, according to specified probabilities.
%       R = randsample('ACGT',48,true,[0.15 0.35 0.35 0.15])
%
%    See also RAND, RANDPERM, RANDSTREAM.
%
%    Reference page in Doc Center
%       doc randsample
%
%    Other functions named randsample
%
%       generic/randsample
%


function PQ = paddedsize(AB,CD,PARAM)
%PADDEDSIZE Computes padded sizes useful for FFT-based filtering.
%   PQ = PADDEDSIZE(AB), where AB is a two-element vector, computes the
%   two-element vector PQ = 2*AB.
%
%   PQ = PADDEDSIZE(AB,'PWR2') computes the vector PQ such that PQ(1) =
%   PQ(2) = 2^nextpow2(2*m), where m is MAX(AB).
%
%   PQ = PADDEDSIZE(AB,CD), where AB and CD are two-element size vectors,
%   computes the two-element size vector PQ. The elements of PQ are the
%   smallest even integers greater than or equal to AB + CD - 1.
%
%   PQ = PADDEDSIZE(AB,CD,'PWR2') computes the vector PQ such that PQ(1)
%   = PQ(2) = 2^nextpow2(2*m), where m is MAX([AB,CD]).
%
%   Copyright 2002-2020 Gatesmark
%
%   This function, and other functions in the DIPUM Toolbox, are based
%   on the theoretical and practical foundations established in the
%   book Digital Image Processing Using MATLAB, 3rd ed., Gatesmark
%   Press, 2020.
%
%   Book website: http://www.imageprocessingplace.com
%   License: https://github.com/dipum/dipum-toolbox/blob/master/LICENSE.txt

if nargin == 1
   PQ  = 2*AB;
elseif nargin == 2 && ~ischar(CD)
   PQ = AB + CD - 1;
   PQ = 2*ceil(PQ/2);
elseif nargin == 2
   m = max(AB); % Maximum dimension.

   % Find power-of-2 at least twice m.
   P = 2^nextpow2(2*m);
   PQ = [P,P];
elseif (nargin == 3) && strcmpi(PARAM,'pwr2')
   m = max([AB,CD]); % Maximum dimension.
   P = 2^nextpow2(2*m);
   PQ = [P,P];
else
   error('Wrong number of inputs.')
end


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

% Conversion between continuous time and discrete time systems

%continious to discrete
n=[1 10];
d=[1 0];
Hs=tf(n,d)

Ts=0.2;
Hz=c2d(Hs,Ts,'zoh')

%discrete to continious
num= [1 1];
den=[1 -1];
Ts=0.2;
Hz=tf(num,den,Ts)

Hs=d2c(Hz,'zoh')


function [weight] = anticor_expert(data, weight_o, w)
% This program generates portfolio for a specified parameter setting.
% Anticor expert
% while the original version is based on loop, which is slow in matlab,
% I replace the code using matrix operations
% Most previous experiments run based on the commented version, at the end
% of the file.
%
% function [weight] = anticor_expert(data, weight_o, w)
%
% weight: experts portfolio, used for next rebalance/combination
%
% data: market sequence vectors
% weight_o: last portfolio, also can be last price relative adjusted.
% w: window size for the experts
%
% Example: [weight] = anticor_expert(data, weight_o, 30)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This file is part of OLPS: http://OLPS.stevenhoi.org/
% Original authors: Bin LI, Steven C.H. Hoi
% Contributors:
% Change log:
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

[T, N]=size(data);
weight = weight_o;

% 1. Return the current portfolio if t < 2w
if (T >= 2*w),
    % 2. Compute LX1, LX2
    LX1 = log(data((T-2*w+1):(T-w),:));
    LX2 = log(data((T-w+1):T,:));

    % 2. Compute averages of LX1 and LX2
    mu1 = mean(LX1);
    mu2 = mean(LX2);

    % M_cor = corr(LX1, LX2);
    M_cov = zeros(N, N);
    M_cor = zeros(N, N);

    % I replace the following loop using matrix operations
    n_LX1 = LX1(:, :) - repmat(mu1, [w, 1]);
    n_LX2 = LX2(:, :) - repmat(mu2, [w, 1]);

    Std1 = diag(n_LX1'*n_LX1)/(w-1);
    Std2 = diag(n_LX2'*n_LX2)/(w-1);
    Std12 = Std1*Std2';
    M_cov = n_LX1'*n_LX2/(w-1);

    M_cor(Std12==0) = 0;
    M_cor(Std12~=0) = M_cov(Std12~=0)./sqrt(Std12(Std12~=0));

    % claim varialbe, matrixization
    claim = zeros(N);
    w_mu2 = repmat(mu2', [1, N]);
    w_mu1 = repmat(mu2, [N, 1]);
    s_12 = (w_mu2 >= w_mu1) & (M_cor > 0);
    claim(s_12) = claim(s_12) + M_cor(s_12);

    diag_M_cor = diag(M_cor);
    cor1 = max(0, repmat(-diag_M_cor, [1, N]));
    cor2 = max(0, repmat(-diag_M_cor', [N, 1]));
    claim(s_12) = claim(s_12) + cor1(s_12) + cor2(s_12);

    transfer = zeros(N);
    sum_claim = repmat(sum(claim, 2), [1, N]);
    s_1 = abs(sum_claim) > 0;
    w_weight_o = repmat(weight_o, [1, N]);
    transfer(s_1) = w_weight_o(s_1).*claim(s_1)./sum_claim(s_1);

    % Use matrix operations, replacing the following loop
    transfer_ij = transfer'-transfer;
    weight = weight - sum(transfer_ij)';
end
end

%     for i=1:N,
%         for j = 1:N,
%             M_cov(i, j) = (LX1(:, i)-mu1(:, i))'*(LX2(:, j) - mu2(:, j))/(w-1);
%
%             % Std1 = Std(LX1(:, i)
%             Std1 = (LX1(:, i) - mu1(:, i))'*(LX1(:, i) - mu1(:, i))/(w-1);
%             Std2 = (LX2(:, j) - mu2(:, j))'*(LX2(:, j) - mu2(:, j))/(w-1);
%
%             if (Std12(i, j) == 0),
%                 M_cor(i, j) = 0;
%             else
%                 M_cor(i, j) = M_cov(i, j) / sqrt(Std1(i, 1)*Std2(j, 1));
%             end
%         end
%     end

%
%     for i = 1:N,
%         for j = 1:N,
%             if ((mu2(i) >= mu2(j)) && (M_cor(i, j) > 0)),
%                 claim(i, j) = claim(i, j) + M_cor(i, j);
% %                 claim(i, j) = claim(i, j) + max(0, -M_cor(i, i));
% %                 claim(i, j) = claim(i, j) + max(0, -M_cor(j, j));
%             end
%         end
%     end
%     for i = 1:N,
%         sum_claim_i = sum(claim(i, :));
%         if (abs(sum_claim_i) > 0)
%             for j = 1:N,
%                 transfer(i, j) = weight_o(i)*claim(i, j)/sum_claim_i;
%             end
%         end
%     end
%     for i = 1:N,
%         for j = 1:N,
%             weight(i) = weight(i) - transfer(i, j) + transfer(j, i);
%         end
%     end


function y = vl_sigmoid(x)
% VL_SIGMOID Sigmoid function
%   Y = VL_SIGMOID(X) returns
%
%    Y = 1 ./ (1 + EXP(X)) ;
%
%   Remark::
%     Useful properties of the sigmoid function are:
%
%     -  1 - VL_SIGMOID(X) = VL_SIGMOID(-X)
%     -  Centered sigmoid: 2 * VL_SIGMOID(X) - 1 ;
%     -  VL_SIGMOID(X) = (EXP(X/2) - EXP(X/2)) / (EXP(X/2) + EXP(X/2))
%
%   See also: VL_DSIGMOID(), VL_HELP().

% Copyright (C) 2007-12 Andrea Vedaldi and Brian Fulkerson.
% All rights reserved.
%
% This file is part of the VLFeat library and is made available under
% the terms of the BSD license (see the COPYING file).

y = 1 ./ (1 + exp(-x)) ;


function [xi,yi] = snakeinterp(x,y,dmax,dmin)
%----------This function is used for interpolating the snake adaptively

%   dmax: the maximum distance between two snake points
%   dmin: the maximum distance between two snake points
%   d(i,i+1)>dmax, then a new point is added between i and i+1
%   d(i,i+1)<dmin, then either i or i+1 is removed
%

x = x(:); y = y(:);

N = length(x);

d = abs(x([2:N 1])- x(:)) + abs(y([2:N 1])- y(:));

% remove the points which distance to neighbor points is shorter than dmin
IDX = (d<dmin);

idx = find(IDX==0);
x = x(idx);
y = y(idx);

N = length(x);
d = abs(x([2:N 1])- x(:)) + abs(y([2:N 1])- y(:));

IDX = (d>dmax);

z = snakeindex(IDX);

p = 1:N+1;

xi = interp1(p,[x;x(1)],z');
yi = interp1(p,[y;y(1)],z');

N = length(xi);
d = abs(xi([2:N 1])- xi(:)) + abs(yi([2:N 1])- yi(:));

while (max(d)>dmax),

    IDX = (d>dmax);
    z = snakeindex(IDX);

    p = 1:N+1;

    xi = interp1(p,[xi;xi(1)],z');
    yi = interp1(p,[yi;yi(1)],z');

    N = length(xi);
    d = abs(xi([2:N 1])- xi(:)) + abs(yi([2:N 1])- yi(:));
end


function y = A_fhp_rect(x, OMEGA, m, n)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Author: Shiqian Ma
% Date : 09/05/2007
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% yc = 1/n*fft2(reshape(x,m,n));

yc = 1/sqrt(m*n)*fft2(reshape(x,m,n));
%%%% y = [yc(1,1); sqrt(2)*real(yc(OMEGA)); sqrt(2)*imag(yc(OMEGA))];
y = [yc(1,1); real(yc(OMEGA)); imag(yc(OMEGA))];


function F=dwt_fuse(I1,I2,zt)
%    DWT
%    Input:
%    I1 - input image A
%    I2 - input image B
%    zt - maximum decomposition level
%    Output:
%    F  - fused image
%
%    The code is edited by Yu Liu, 01-09-2014.

%-------------------------------------------------------------------------%
%                                DWT
%-------------------------------------------------------------------------%
I1=double(I1);
I2=double(I2);
tempA=I1;
tempB=I2;

X=cell(zt,4);
Y=cell(zt,4);
Z=cell(zt,4);
for i=1:zt
    [X{i,1},X{i,2},X{i,3},X{i,4}]=dwt2(tempA,'db1','mode','per');
    tempA=X{i,1};
    [Y{i,1},Y{i,2},Y{i,3},Y{i,4}]=dwt2(tempB,'db1','mode','per');
    tempB=Y{i,1};
end

%-------------------------------------------------------------------------%
%                               low-pass fusion
%-------------------------------------------------------------------------%
Z{zt,1}=(X{zt,1}+Y{zt,1})/2;

%-------------------------------------------------------------------------%
%                               high-pass fusion
%-------------------------------------------------------------------------%
for i=zt:-1:1
    for j=2:4
        Z{i,j}=selc(X{i,j},Y{i,j},3);
    end
end

%-------------------------------------------------------------------------%
%                               IDWT
%-------------------------------------------------------------------------%
for i=zt:-1:1
    if i>1
        Z{i-1,1}=idwt2(Z{i,1},Z{i,2},Z{i,3},Z{i,4},'db1','mode','per');
    else
        F=idwt2(Z{i,1},Z{i,2},Z{i,3},Z{i,4},'db1','mode','per');
    end
end


function op = prox_Sl1( lambda )
%PROX_SL1    Sorted/Ordered L1 norm.
%    OP = PROX_L1( lambda ) implements the nonsmooth function
%        OP(X) = sum(lambda.*sort(abs(X),'descend'))
%    where lambda is strictly positive and sorted in decreasing order,
%    in which case this function is a norm (and hence convex).
%    If lambda is a scalar, it will be expanded to all elements, but in this
%    case it is equivalent to the (scaled) usual l1 norm.
%
%    Notice: this function uses mex files. Some pre-compiled binaries
%       for common systems are included; if these do not work for you,
%       then please install yourself. In the mexFiles/ subdirectory,
%       run the file "makeMex.m"
% Reference:
%  http://www-stat.stanford.edu/~candes/OrderedL1/
% "Statistical Estimation and Testing via the Ordered L1 Norm"
% by M. Bogdan, E. van den Berg, W. Su, and E. J. Candès
% 2013
%
% See also prox_l1.m, makeMex.m

if nargin == 0,
	lambda = 1;
elseif ~isnumeric( lambda ) || ~isreal( lambda ) ||  any( lambda(:) <= 0 )
	error( 'Argument lambda must have all positive entries.' );
end
if ~issorted(flipud(lambda(:)))
    error( 'Argument lambda must be sorted in decreasing order.');
end
if numel(lambda)==1
    warning('TFOCS:prox_SL1','When lambda is a scalar, we recommend prox_l1.m instead pf prox_SL1.m');
end

% The mex file is in the child directory mexFiles/
% Check for its existence. First, add the right paths
addpath(fullfile(tfocs_where,'mexFiles'));
if 3 ~= exist('proxAdaptiveL1Mex','file')
    makeMex;
    % check that it worked
    if 3 ~= exist('proxAdaptiveL1Mex','file')
        disp('Compilation of mex files for prox_SL1.m failed; please report this error');
    end
end

f       = @(x) sum( lambda(:) .* sort(abs(x(:)), 'descend') );
prox_f  = @(x,t) proxOrderedL1(x,t.*lambda);

op      = tfocs_prox( f, prox_f , 'vector' ); % Allow vector stepsizes

end

% -- subroutines --
function x = proxOrderedL1(y,lambda)
    % Normalization
    lambda = lambda(:);
    y      = y(:);
    sgn    = sign(y);
    [y,idx] = sort(abs(y),'descend');

    % Simplify the problem
    k = find(y > lambda,1,'last');

    % Compute solution and re-normalize
    n = numel(y);
    x = zeros(n,1);

    if (~isempty(k))
        v1 = y(1:k);
        if numel(lambda) > 1
            v2 = lambda(1:k);
        else
            v2 = lambda*ones(k,1); % if lambda is a scalar, implicity make it lambda*ones(size(y))
        end
        v = proxAdaptiveL1Mex(v1,v2);
        x(idx(1:k)) = v;
    end

    % Restore signs
    x = sgn .* x;
end

% TFOCS v1.3 by Stephen Becker, Emmanuel Candes, and Michael Grant.
% Copyright 2013 California Institute of Technology and CVX Research.
% See the file LICENSE for full license information.


function [t, stats] = upsampledttest(x,ufac,w);
% upsampledttest - t test for upsampled data
%
% [t, stat_struct] = upsampledttest(x,upsamplefactor,weight)
%
% T test for upsampled data (e.g. V1 in 1x1x1mm3 while the actual data was
% collected at some larger voxel size). The correction is based upon the
% assumption that upsampling duplicates the original dataset
% (upsamplefactor). This is true for nearest-neighbor interpolation and
% roughly true for linear interpolation schemes. If this correction is not
% taken into account the t-values will be overestimated.
% Option to specify weight for each value.
%
% example:
%   a = rand(100,1);
%   b = a*ones(1,100);b=b(:);
%    upsampledttest(a,1)
%   equals,
%    upsampledttest(b,100)
%
% 2006/06/01 SOD: wrote it.

if nargin < 2 || isempty(ufac),
  ufac = 1;
end;

if size(x,1) == 1, x = x(:); end;

% mean and n
xmean = mean(x);
n     = size(x,1);

% define corrected df
stats.df    = n./ufac-1;
% this could go below 0
if stats.df < 0,
    disp(sprintf(['[%s]:WARNING:corrected df < 0, setting to something ' ...
                  'small. Use data with caution.'],mfilename));
    stats.df  = 0.00001;
end;

% variance corrected for upsampling
xvar  = ( sum((x-xmean).^2) ./ufac) ./ stats.df;

% t (df corrected for upsampling)
t     = xmean ./ sqrt(xvar ./ (n./ufac));

% compute more stats if requested
if nargout > 1,
  stats.t     = t;
  stats.mean  = xmean;
  stats.stdev = sqrt(xvar);
  stats.sterr = sqrt(xvar)./sqrt(n./ufac);
  stats.p     = 0.5*betainc(stats.df./(stats.df+t.^2),stats.df/2,0.5);
end;

return;


function disk_grid_test01 ( )

%*****************************************************************************80
%
%% DISK_GRID_TEST01 tests DISK_GRID.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    09 November 2011
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST01:\n' );
  fprintf ( 1, '  DISK_GRID can define a grid of points\n' );
  fprintf ( 1, '  with N+1 points on a horizontal or vertical radius,\n' );
  fprintf ( 1, '  based on any disk.\n' );

  n = 20;
  r = 2.0;
  c = [ 1.0, 5.0 ];

  fprintf ( 1, '\n' );
  fprintf ( 1, '  We use N = %d\n', n );
  fprintf ( 1, '  Radius R = %f\n', r );
  fprintf ( 1, '  Center C = (%f,%f)\n', c(1), c(2) );

  ng = disk_grid_count ( n, r, c );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of grid points will be %d\n', ng );

  cg = disk_grid ( n, r, c, ng );

  r82vec_print_part ( ng, cg, 20, '  Part of the grid point array:' );

  filename = 'disk_grid_test01.xy';

  r8mat_write ( filename, 2, ng, cg );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Data written to the file "%s".\n', filename );
%
% Plot the points.
%
  i = 0 : 50;
  t = 2.0 * pi * i / 50.0;
  cx = c(1);
  cx = cx + r .* cos ( t );
  cy = c(2);
  cy = cy + r .* sin ( t );

  figure
  clf
  hold on
  plot ( cx, cy, 'r-', 'Linewidth', 3 )
  plot ( cg(1,1:ng), cg(2,1:ng), 'b.' )
  hold off
  axis equal
  xlabel ( '<---X--->', 'Fontsize', 16 )
  ylabel ( '<---Y--->', 'Fontsize', 16 )
  title ( sprintf ( 'Circle grid with %d points', ng ), 'Fontsize', 16 );
  filename = 'disk_grid_test01.png';
  print ( '-dpng', filename );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Graphics data saved in file "%s"\n', filename );

  return
end


function pdflib_test01 ( )

%*****************************************************************************80
%
%% PDFLIB_TEST01 tests R8MAT_POFAC.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 June 2013
%
%  Author:
%
%    John Burkardt
%
  n = 5;

  fprintf ( 1, '\n' );
  fprintf ( 1, 'PDFLIB_TEST01\n' );
  fprintf ( 1, '  R8MAT_POFAC computes the Cholesky factor R of a\n' );
  fprintf ( 1, '  positive definite matrix A, so that A = R'' * R.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Start with random R1;\n' );
  fprintf ( 1, '  Compute A = R1'' * R1.\n' );
  fprintf ( 1, '  Call R8MAT_POFAC and see if you recover R2 = R1.\n' );
%
%  Generate a random upper triangular matrix with positive diagonal.
%
  r1 = zeros ( n, n );

  for j = 1 : n
    for i = 1 : j
       r1(i,j) = r8_uniform_01_sample ( );
    end
  end

  r8mat_print ( n, n, r1, '  R1:' );
%
%  Compute a positive definite symmetric matrix A.
%
  a = r1' * r1;

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

  r2 = r8mat_pofac ( n, a );

  diff = r8mat_norm_fro_affine ( n, n, r1, r2 );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Frobenius difference between R1 and R2 = %g\n', diff );

  return
end


%% Machine Learning Online Class - Exercise 1: Linear Regression

%  Instructions
%  ------------
%
%  This file contains code that helps you get started on the
%  linear exercise. You will need to complete the following functions
%  in this exericse:
%
%     warmUpExercise.m
%     plotData.m
%     gradientDescent.m
%     computeCost.m
%     gradientDescentMulti.m
%     computeCostMulti.m
%     featureNormalize.m
%     normalEqn.m
%
%  For this exercise, you will not need to change any code in this file,
%  or any other files other than those mentioned above.
%
% x refers to the population size in 10,000s
% y refers to the profit in $10,000s
%

%% Initialization
clear ; close all; clc

%% ==================== Part 1: Basic Function ====================
% Complete warmUpExercise.m
fprintf('Running warmUpExercise ... \n');
fprintf('5x5 Identity Matrix: \n');
warmUpExercise()

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

%% ======================= Part 2: Plotting =======================
fprintf('Plotting Data ...\n')
data = load('ex1data1.txt');
X = data(:, 1); y = data(:, 2);
m = length(y); % number of training examples

% Plot Data
% Note: You have to complete the code in plotData.m
plotData(X, y);

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

%% =================== Part 3: Gradient descent ===================
fprintf('Running Gradient Descent ...\n')

X = [ones(m, 1), data(:,1)]; % Add a column of ones to x
theta = zeros(2, 1); % initialize fitting parameters

% Some gradient descent settings
iterations = 1500;
alpha = 0.01;

% compute and display initial cost
computeCost(X, y, theta)

% run gradient descent
theta = gradientDescent(X, y, theta, alpha, iterations);

% print theta to screen
fprintf('Theta found by gradient descent: ');
fprintf('%f %f \n', theta(1), theta(2));

% Plot the linear fit
hold on; % keep previous plot visible
plot(X(:,2), X*theta, '-')
legend('Training data', 'Linear regression')
hold off % don't overlay any more plots on this figure

% Predict values for population sizes of 35,000 and 70,000
predict1 = [1, 3.5] *theta;
fprintf('For population = 35,000, we predict a profit of %f\n',...
    predict1*10000);
predict2 = [1, 7] * theta;
fprintf('For population = 70,000, we predict a profit of %f\n',...
    predict2*10000);

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

%% ============= Part 4: Visualizing J(theta_0, theta_1) =============
fprintf('Visualizing J(theta_0, theta_1) ...\n')

% Grid over which we will calculate J
theta0_vals = linspace(-10, 10, 100);
theta1_vals = linspace(-1, 4, 100);

% initialize J_vals to a matrix of 0's
J_vals = zeros(length(theta0_vals), length(theta1_vals));

% Fill out J_vals
for i = 1:length(theta0_vals)
    for j = 1:length(theta1_vals)
	  t = [theta0_vals(i); theta1_vals(j)];
	  J_vals(i,j) = computeCost(X, y, t);
    end
end

% Because of the way meshgrids work in the surf command, we need to
% transpose J_vals before calling surf, or else the axes will be flipped
J_vals = J_vals';
% Surface plot
figure;
surf(theta0_vals, theta1_vals, J_vals)
xlabel('\theta_0'); ylabel('\theta_1');

% Contour plot
figure;
% Plot J_vals as 15 contours spaced logarithmically between 0.01 and 100
contour(theta0_vals, theta1_vals, J_vals, logspace(-2, 3, 20))
xlabel('\theta_0'); ylabel('\theta_1');
hold on;
plot(theta(1), theta(2), 'rx', 'MarkerSize', 10, 'LineWidth', 2);


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% FUNCTION: computes the angular displacements of a simple gravity pendulum
%
% PURPOSE: to illustrate no change in oscillatory amplitude under
% variations in the radius of the pendulum bob.
%
% Author: N.A. Battista
% Date: 12/13/2019
% Institution: The College of New Jersey
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

function simple_pendulum()

%
% Physical Parameters
%
m = 100;    % Mass of Pendulum bob
g=9.80665;  % Gravitational Acceleration;
L=0.2;      % Length of Pendulum

%
% Vector of Radii
%
rVec = 100*[0.005 0.010 0.015 0.02 0.025];

%
% Temporal Parameters
%
t=0;        % initial time
tFinal = 8; % final-time
dt = 1e-3;  % time-step
ct=1;       % counter
tVec(ct)=t; % time vector storage

%
% Moment of Inertia
%
IVec = m*(0.5*rVec.^2+L^2);

%
% Initial Angular Displacement
%
ang = -(pi/2-pi/5)*ones(1,5);
phi = zeros( size( ang ) );

%
% Perform the time-stepping, e.g., solve the ODEs
%
while t<=tFinal

    % increment the storage counter
    ct = ct+1;

    % increment time
    t = t+dt;

    % save current time
    tVec(ct) = t;

    % solve 1st order ODE for angular displacement
    ang(ct,:) = ang(ct-1,:) + dt * ( phi(ct-1,:) );

    % solve 1st order ODE for angular velocity
    phi(ct,:) = phi(ct-1,:) + dt * ( -m*g*L ./IVec .* sin( ang(ct-1,:) ) );

end

%
% Defining Colors for Plotting Data
%
color2 = [0.635 0.078 0.184];  % dark red
color5 = [0.9 0.525 0.098];    % orange
color6 = [0.929 0.840 0.1250]; % dark yellow
color7 = [0.7 0.7 0];          % 'ugly' green

%
% Note discrepancy is a bit off due to small angle approximation:
% sin(theta) ~ theta gives below period of oscillation
%
T1 = 2*pi*sqrt( IVec(1) / (m*g*L) );
%
% Actually computed value of period is:
T1 = 1.93;

%
% Make Figure of Angular Displacement vs. Non-dimensional Time (# of oscillations of 'r' case)
%
lw=6;
fs=18;
plot(tVec/T1,ang(:,1),'k-','LineWidth',lw); hold on;
plot(tVec/T1,ang(:,2),'b-','LineWidth',lw,'Color',color2); hold on;
plot(tVec/T1,ang(:,3),'g-','LineWidth',lw,'Color',color5); hold on;
plot(tVec/T1,ang(:,4),'r-','LineWidth',lw,'Color',color6); hold on;
plot(tVec/T1,ang(:,5),'c-','LineWidth',lw,'Color',color7); hold on;
xlabel('Non-Dimensional Time (# periods of r-case)');
ylabel('Angular Displacement (Radians)');
axis([0 4*T1 -1 1.25]);
leg=legend('r','2r','3r','4r','5r','Orientation','horizontal');
set(gca,'FontSize',fs);
set(leg,'FontSize',fs);


function point = intersectLines(line1, line2, varargin)
%INTERSECTLINES Return all intersection points of N lines in 2D
%
%   PT = intersectLines(L1, L2);
%   returns the intersection point of lines L1 and L2. L1 and L2 are 1-by-4
%   row arrays, containing parametric representation of each line (in the
%   form [x0 y0 dx dy], see 'createLine' for details).
%
%   In case of colinear lines, returns [Inf Inf].
%   In case of parallel but not colinear lines, returns [NaN NaN].
%
%   If each input is [N*4] array, the result is a [N*2] array containing
%   intersections of each couple of lines.
%   If one of the input has N rows and the other 1 row, the result is a
%   [N*2] array.
%
%   PT = intersectLines(L1, L2, EPS);
%   Specifies the tolerance for detecting parallel lines. Default is 1e-14.
%
%   Example
%   line1 = createLine([0 0], [10 10]);
%   line2 = createLine([0 10], [10 0]);
%   point = intersectLines(line1, line2)
%   point =
%       5   5
%
%   See also
%   lines2d, edges2d, intersectEdges, intersectLineEdge
%   intersectLineCircle
%
%   ---------
%   author : David Legland
%   INRA - TPV URPOI - BIA IMASTE
%   created the 31/10/2003.
%

%   HISTORY
%   2004-02-19 add support for multiple lines.
%   2007-03-08 update doc
%   2011-10-07 code cleanup

%% Process input arguments

% extract tolerance
tol = 1e-14;
if ~isempty(varargin)
    tol = varargin{1};
end

% check size of each input
N1 = size(line1, 1);
N2 = size(line2, 1);
N = max(N1, N2);
if N1 ~= N2 && N1*N2 ~= N
    error('matGeom:IntersectLines:IllegalArgument', ...
        'The two input arguments must have same number of lines');
end

%% Check parallel and colinear lines

% coordinate differences of origin points
dx = bsxfun(@minus, line2(:,1), line1(:,1));
dy = bsxfun(@minus, line2(:,2), line1(:,2));

% indices of parallel lines
denom = line1(:,3) .* line2(:,4) - line2(:,3) .* line1(:,4);
par = abs(denom) < tol;

% indices of colinear lines
col = abs(dx .* line1(:,4) - dy .* line1(:,3)) < tol & par ;

% initialize result array
x0 = zeros(N, 1);
y0 = zeros(N, 1);

% initialize result for parallel lines
x0(col) = Inf;
y0(col) = Inf;
x0(par & ~col) = NaN;
y0(par & ~col) = NaN;

% in case all line couples are parallel, return
if all(par)
    point = [x0 y0];
    return;
end

%% Extract coordinates of itnersecting lines

% indices of intersecting lines
inds = ~par;

% extract base coordinates of first lines
if N1 > 1
    line1 = line1(inds,:);
end
x1 =  line1(:,1);
y1 =  line1(:,2);
dx1 = line1(:,3);
dy1 = line1(:,4);

% extract base coordinates of second lines
if N2 > 1
    line2 = line2(inds,:);
end
x2 =  line2(:,1);
y2 =  line2(:,2);
dx2 = line2(:,3);
dy2 = line2(:,4);

% re-compute coordinate differences of origin points
dx = bsxfun(@minus, line2(:,1), line1(:,1));
dy = bsxfun(@minus, line2(:,2), line1(:,2));

%% Compute intersection points

denom = denom(inds);
x0(inds) = (x2 .* dy2 .* dx1 - dy .* dx1 .* dx2 - x1 .* dy1 .* dx2) ./ denom ;
y0(inds) = (dx .* dy1 .* dy2 + y1 .* dx1 .* dy2 - y2 .* dx2 .* dy1) ./ denom ;

% concatenate result
point = [x0 y0];


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 = sigmoid(X * theta);

idx_1 = find(p >= 0.5);
idx_0 = find(p < 0.5);

p(idx_1) = ones(size(idx_1));
p(idx_0) = zeros(size(idx_0));

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

end


function [ value, ifault ] = alogam ( x )

%*****************************************************************************80
%
%% ALOGAM computes the logarithm of the Gamma function.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 January 2008
%
%  Author:
%
%    Original FORTRAN77 version by Malcolm Pike, David Hill.
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Malcolm Pike, David Hill,
%    Algorithm 291:
%    Logarithm of Gamma Function,
%    Communications of the ACM,
%    Volume 9, Number 9, September 1966, page 684.
%
%  Parameters:
%
%    Input, real X, the argument of the Gamma function.
%    X should be greater than 0.
%
%    Output, real ALOGAM, the logarithm of the Gamma
%    function of X.
%
%    Output, integer IFAULT, error flag.
%    0, no error.
%    1, X <= 0.
%
  if ( x <= 0.0 )
    ifault = 1;
    value = 0.0;
    return
  end

  ifault = 0;
  y = x;

  if ( x < 7.0 )

    f = 1.0;
    z = y;

    while ( z < 7.0 )
      f = f * z;
      z = z + 1.0;
    end

    y = z;
    f = - log ( f );

  else

    f = 0.0;

  end

  z = 1.0 / y / y;

  value = f + ( y - 0.5 ) * log ( y ) - y ...
    + 0.918938533204673 + ...
    ((( ...
    - 0.000595238095238   * z ...
    + 0.000793650793651 ) * z ...
    - 0.002777777777778 ) * z ...
    + 0.083333333333333 ) / y;

  return
end


function ising_2d_simulation ( m, n, iterations, thresh, seed )

%*****************************************************************************80
%
%% ISING_2D_SIMULATION carries out a 2D Ising simulation.
%
%  Discussion:
%
%    Note that, when all the cells are updated in a single cycle, there is
%    a mathematically stable checkerboard solution, in which all the reds
%    and blacks flip color repeatedly.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 November 2011
%
%  Author:
%
%    John Burkardt
%
  timestamp ( );
  fprintf ( 1, '\n' );
  fprintf ( 1, 'ISING_2D_SIMULATION\n' );
  fprintf ( 1, '  MATLAB version\n' );
  fprintf ( 1, '  Monte Carlo simulation of a 2D Ising model.\n' );
%
%  Arguments not supplied are set to default values.
%
  if ( nargin < 1 )
    m = 10;
  else
    m = str2num ( m );
  end

  if ( nargin < 2 )
    n = 10;
  else
    n = str2num ( n );
  end

  if ( nargin < 3 )
    iterations = 15;
  else
    iterations = str2num ( iterations );
  end

  if ( nargin < 4 )
    thresh = 0.50;
  else
    thresh = str2num ( thresh );
  end

  if ( nargin < 5 )
    seed = 123456789;
  else
    seed = str2num ( seed );
  end
%
%  Define the probability of flipping if you are in a neighborhood of
%  1, 2, 3, 4, or 5 of the same sign.
%
%  This should really be some kind of exponential dependent on "temperature".
%
  prob = [ 0.98, 0.85, 0.50, 0.15, 0.02 ];

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The row dimension M = %d\n', m );
  fprintf ( 1, '  The column dimension N = %d\n', n );
  fprintf ( 1, '  The number of iterations taken is ITERATIONS = %d\n', iterations );
  fprintf ( 1, '  The threshhold THRESH = %f\n', thresh );
  fprintf ( 1, '  The seed SEED = %d\n', seed );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  The transition probability table, based on the number of\n' );
  fprintf ( 1, '  neighbors with the same charge.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '        1           2           3           4           5\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  %10.4f  %10.4f  %10.4f  %10.4f  %10.4f\n', prob(1:5) );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  An automatic pause of 2 seconds is imposed between \n;' );
  fprintf ( 1, '  successive displays.\n' );
%
%  Initialize C1.
%
  [ c1, seed ] = ising_2d_initialize ( m, n, thresh, seed );
%
%  Do the simulation.
%
  [ c1, seed ] = transition ( m, n, iterations, prob, seed, c1 );
%
%  Terminate.
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'ISING_2D_SIMULATION\n' );
  fprintf ( 1, '  Normal end of execution.\n' );

  fprintf ( 1, '\n' );
  timestamp ( );

  return
end
function i4mat_print ( m, n, a, title )

%*****************************************************************************80
%
%% I4MAT_PRINT prints an I4MAT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 September 2009
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns of the matrix.
%
%    Input, integer A(M,N), an M by N matrix to be printed.
%
%    Input, string TITLE, a title.
%
  i4mat_print_some ( m, n, a, 1, 1, m, n, title );

  return
end
function i4mat_print_some ( m, n, a, ilo, jlo, ihi, jhi, title )

%*****************************************************************************80
%
%% I4MAT_PRINT_SOME prints out a portion of an I4MAT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 February 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns of the matrix.
%
%    Input, integer A(M,N), an M by N matrix to be printed.
%
%    Input, integer ILO, JLO, the first row and column to print.
%
%    Input, integer IHI, JHI, the last row and column to print.
%
%    Input, string TITLE, a title.
%
  incx = 10;

  fprintf ( 1, '\n' );
  fprintf ( 1, '%s\n', title );

  if ( m <= 0 || n <= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  (None)\n' );
    return
  end

  for j2lo = max ( jlo, 1 ): incx : min ( jhi, n )

    j2hi = j2lo + incx - 1;
    j2hi = min ( j2hi, n );
    j2hi = min ( j2hi, jhi );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Col: ' );

    for j = j2lo : j2hi
      fprintf ( 1, '%7d  ', j );
    end

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Row\n' );
    fprintf ( 1, '\n' );

    i2lo = max ( ilo, 1 );
    i2hi = min ( ihi, m );

    for i = i2lo : i2hi

      fprintf ( 1, '%5d: ', i );
      for j = j2lo : j2hi
        fprintf ( 1, '%7d  ', a(i,j) );
      end

      fprintf ( 1, '\n' );

    end

  end

  return
end
function [ c, seed ] = i4mat_uniform ( m, n, a, b, seed )

%*****************************************************************************80
%
%% I4MAT_UNIFORM returns a scaled pseudorandom I4MAT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 November 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Springer Verlag, pages 201-202, 1983.
%
%    Pierre L'Ecuyer,
%    Random Number Generation,
%    in Handbook of Simulation,
%    edited by Jerry Banks,
%    Wiley Interscience, page 95, 1998.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%    Peter Lewis, Allen Goodman, James Miller
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, pages 136-143, 1969.
%
%  Parameters:
%
%    Input, integer M, N, the row and column dimensions of the matrix.
%
%    Input, integer A, B, the minimum and maximum acceptable values.
%
%    Input, integer SEED, a seed for the random number generator.
%
%    Output, integer C(M,N), the randomly chosen integer vector.
%
%    Output, integer SEED, the updated seed.
%
  if ( seed == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'I4MAT_UNIFORM - Fatal error!\n' );
    fprintf ( 1, '  Input SEED = 0!\n' );
    error ( 'I4MAT_UNIFORM - Fatal error!' );
  end

  seed = floor ( seed );
  a = round ( a );
  b = round ( b );

  for j = 1 : n

    for i = 1 : m

      seed = mod ( seed, 2147483647 );

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

      k = floor ( seed / 127773 );

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

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

      r = seed * 4.656612875E-10;
%
%  Scale R to lie between A-0.5 and B+0.5.
%
      r = ( 1.0 - r ) * ( min ( a, b ) - 0.5 ) ...
        +         r   * ( max ( a, b ) + 0.5 );
%
%  Use rounding to convert R to an integer between A and B.
%
      value = round ( r );

      value = max ( value, min ( a, b ) );
      value = min ( value, max ( a, b ) );

      c(i,j) = value;

    end
  end

  return
end
function c5 = ising_2d_agree ( m, n, c1 )

%*****************************************************************************80
%
%% ISING_2D_AGREE returns the number of neighbors agreeing with each cell.
%
%  Discussion:
%
%    The count includes the cell itself, so it is between 1 and 5.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of cells in each spatial dimension.
%
%    Input, integer C1(M,N), an array of 1's and -1's.
%
%    Output, integer C5(M,N), the number of neighbors that agree.
%    1, 2, 3, 4, or 5.
%
  c5 = c1 ...
     + circshift ( c1, [ -1,  0 ] ) ...
     + circshift ( c1, [ +1,  0 ] ) ...
     + circshift ( c1, [  0, -1 ] ) ...
     + circshift ( c1, [  0, +1 ] );

  i = find ( 0 < c1 );
  c5(i) = ( 5 + c5(i) ) / 2;

  i = find ( c1 < 0 );
  c5(i) = ( 5 - c5(i) ) / 2;

  return
end
function ising_2d_display ( step, m, n, c1 )

%*****************************************************************************80
%
%% ISING_2D_DISPLAY displays the current Ising status.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer STEP, the step number.
%
%    Input, integer M, N, the number of rows and columnss.
%
%    Input, integer C1(M,N), the status of each cell:
%    -1, display as a shade of red.
%    +1, display as a shade of blue.
%
  figure ( 1 )
%
%  Clear the graphics frame.
%
  clf
%
%  Determine the plot range.
%
  margin = 0.05;

  x_axes_min = 1.0 - 0.5 - margin;
  x_axes_max = m   + 0.5 + margin;
  y_axes_min = 1.0 - 0.5 - margin;
  y_axes_max = n   + 0.5 + margin;
%
%  Fill in the background with black.
%
  x1 = x_axes_min;
  x2 = x_axes_max;
  y1 = y_axes_min;
  y2 = y_axes_max;

  rgb = [ 0.5, 0.5, 0.5 ];

  fill ( [ x1, x2, x2, x1 ], [ y1, y1, y2, y2 ], rgb );
  hold on
%
%  Draw a square, representing the bed,
%  with most of the length and width, centered at (I,J).
%
  for i = 1 : m
    for j = 1 : n

      x1 = j - 0.47;
      x2 = j + 0.47;
      y1 = ( m + 1 - i ) - 0.47;
      y2 = ( m + 1 - i ) + 0.47;

      if ( c1(i,j) == - 1 )
        rgb = [ 1.0, 0.0, 0.0 ];
      elseif ( c1(i,j) == + 1 )
        rgb = [ 0.0, 0.0, 1.0 ];
      end

      fill ( [ x1, x2, x2, x1 ], [ y1, y1, y2, y2 ], rgb );
      hold on

    end
  end
%
%  Make a title.
%
  title_string = sprintf ( 'Ising charges +1/-1 on step %d', step );

  title ( title_string )
%
%  Choose the aspect ratio and other plot details.
%
  axis ( [ x_axes_min, x_axes_max, y_axes_min, y_axes_max] );
  axis equal
  axis tight
  axis off

  hold off

  pause ( 2 )

  return
end
function [ c1, seed ] = ising_2d_initialize ( m, n, thresh, seed )

%*****************************************************************************80
%
%% ISING_2D_INITIALIZE initializes the Ising array.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, real THRESH, the threshhold value, between 0 and 1.
%
%    Input, integer SEED, a seed for the random number generator.
%
%    Output, integer C1(M,N), an array of 1's and -1's.
%
%    Output, integer SEED, a seed for the random number generator.
%
  c1 = ones ( m, n );

  [ r, seed ] = r8mat_uniform_01 ( m, n, seed );

  i = find ( r <= thresh );

  c1(i) = -1;

  return
end
function ising_2d_stats ( step, m, n, c1 )

%*****************************************************************************80
%
%% ISING_2D_STATS prints information about the current step.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    19 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer STEP, the step number.
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, integer C1(M,N), the current state of the system.
%
  if ( step == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Step       Positives       Negatives\n' );
    fprintf ( 1, '             #    %%          #    %%\n' );
    fprintf ( 1, '\n' );
  end

  pos_count = sum ( sum ( 0 < c1 ) );
  neg_count = m * n - pos_count;
  pos_percent = ( 100 * pos_count ) / ( m * n );
  neg_percent = ( 100 * neg_count ) / ( m * n );

  fprintf ( 1, '  %4d  %6d  %6.2f  %6d  %6.2f\n', ...
    step, pos_count, pos_percent, neg_count, neg_percent );

  return
end
function neighbor_2d_display ( step, m, n, c1, c5 )

%*****************************************************************************80
%
%% NEIGHBOR_2D_DISPLAY displays the current Ising neighbor status.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer STEP, the step number.
%
%    Input, integer M, N, the number of rows and columnss.
%
%    Input, integer C1(M,N), the status of each cell:
%
%    Input, integer C5(M,N), the number of agreeable neighbors.
%
  figure ( 2 )
%
%  Clear the graphics frame.
%
  clf
%
%  Determine the plot range.
%
  margin = 0.05;

  x_axes_min = 1.0 - 0.5 - margin;
  x_axes_max = m   + 0.5 + margin;
  y_axes_min = 1.0 - 0.5 - margin;
  y_axes_max = n   + 0.5 + margin;
%
%  Fill in the background with black.
%
  x1 = x_axes_min;
  x2 = x_axes_max;
  y1 = y_axes_min;
  y2 = y_axes_max;

  rgb = [ 0.5, 0.5, 0.5 ];

  fill ( [ x1, x2, x2, x1 ], [ y1, y1, y2, y2 ], rgb );
  hold on
%
%  Draw a square, representing the bed,
%  with most of the length and width, centered at (I,J).
%
  for i = 1 : m
    for j = 1 : n

      x1 = j - 0.47;
      x2 = j + 0.47;
      y1 = ( m + 1 - i ) - 0.47;
      y2 = ( m + 1 - i ) + 0.47;

      c = c1(i,j) * c5(i,j);

      if ( c == - 5 )
        rgb = [ 1.0, 0.0, 0.0 ];
      elseif ( c == - 4 )
        rgb = [ 1.0, 0.2, 0.2 ];
      elseif ( c == - 3 )
        rgb = [ 1.0, 0.4, 0.4 ];
      elseif ( c == - 2 )
        rgb = [ 1.0, 0.7, 0.7 ];
      elseif ( c == - 1 )
        rgb = [ 1.0, 0.8, 0.8 ];
      elseif ( c == 0 )
        rgb = [ 1.0, 1.0, 1.0 ];
      elseif ( c == + 1 )
        rgb = [ 0.7, 0.7, 1.0 ];
      elseif ( c == + 2 )
        rgb = [ 0.6, 0.6, 1.0 ];
      elseif ( c == + 3 )
        rgb = [ 0.4, 0.4, 1.0 ];
      elseif ( c == + 4 )
        rgb = [ 0.2, 0.2, 1.0 ];
      elseif ( c == + 5 )
        rgb = [ 0.0, 0.0, 1.0 ];
      end

      fill ( [ x1, x2, x2, x1 ], [ y1, y1, y2, y2 ], rgb );
      hold on

    end
  end
%
%  Make a title.
%
  title_string = sprintf ( 'Ising neighborhoods -5 to +5, step %d to step %d', step-1, step );

  title ( title_string )
%
%  Choose the aspect ratio and other plot details.
%
  axis ( [ x_axes_min, x_axes_max, y_axes_min, y_axes_max] );
  axis equal
  axis tight
  axis off

  hold off

  pause ( 2 )

  return
end
function neighbor_2d_stats ( step, m, n, c1, c5 )

%*****************************************************************************80
%
%% NEIGHBOR_2D_STATS prints neighbor statistics about the current step.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer STEP, the step number.
%
%    Input, integer M, N, the number of rows and columns.
%
%    Input, integer C1(M,N), the current state of the system.
%
%    Input, integer C5(M,N), the number of agreeable neighbors.
%
  if ( step == 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, '  Step     Neighborhood Charge:\n' );
    fprintf ( 1, ...
      '           -5    -4    -3    -2    -1    +1    +2    +3    +4    +5\n' );
    fprintf ( 1, '\n' );
  end

  fprintf ( 1, '  %4d', step );

  for n = -5 : 5
    if ( n ~= 0 )
      c = sum ( sum ( c1 .* c5 == n ) );
      fprintf ( 1, '  %4d', c );
    end
  end
  fprintf ( 1, '\n' );

  return
end
function [ r, seed ] = r8mat_uniform_01 ( m, n, seed )

%*****************************************************************************80
%
%% R8MAT_UNIFORM_01 returns a unit pseudorandom R8MAT.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 September 2006
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Paul Bratley, Bennett Fox, Linus Schrage,
%    A Guide to Simulation,
%    Springer Verlag, pages 201-202, 1983.
%
%    Bennett Fox,
%    Algorithm 647:
%    Implementation and Relative Efficiency of Quasirandom
%    Sequence Generators,
%    ACM Transactions on Mathematical Software,
%    Volume 12, Number 4, pages 362-376, 1986.
%
%    Peter Lewis, Allen Goodman, James Miller,
%    A Pseudo-Random Number Generator for the System/360,
%    IBM Systems Journal,
%    Volume 8, pages 136-143, 1969.
%
%  Parameters:
%
%    Input, integer M, N, the number of rows and columns in the array.
%
%    Input, integer SEED, the integer "seed" used to generate
%    the output random number.
%
%    Output, real R(M,N), an array of random values between 0 and 1.
%
%    Output, integer SEED, the updated seed.  This would
%    normally be used as the input seed on the next call.
%
  r = zeros ( m, n );

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

  for j = 1 : n
    for i = 1 : m

      seed = floor ( seed );

      seed = mod ( seed, 2147483647 );

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

      k = floor ( seed / 127773 );

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

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

      r(i,j) = seed * 4.656612875E-10;

    end
  end

  return
end
function timestamp ( )

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

  return
end
function [ c1, seed ] = transition ( m, n, iterations, prob, seed, c1 )

%*****************************************************************************80
%
%% TRANSITION carries out a Monte Carlo simulation of a 2D Ising model.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    03 November 2011
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer M, N, the number of cells in each spatial
%    dimension.
%
%    Input, integer ITERATIONS, the number of iterations to carry out.
%
%    Input, real PROB(1:5).  PROB(I) represents the probability
%    that the spin of a given cell will be reversed, given that it has I immediate
%    neighbors (including itself) with spin the same as its own.
%
%    Input/output, integer SEED, a seed for the random number generator.
%
%    Input/output, integer C1(M,N).  On input, the current state of the
%    system.  On output, the state of the system after the iterations.
%
  step = 0;
  ising_2d_stats ( step, m, n, c1 );
  ising_2d_display ( step, m, n, c1 );

  for step = 1 : iterations
%
%  C5 contains 1 through 5, the number of cells that agree with the center cell.
%
    c5 = ising_2d_agree ( m, n, c1 );

    if ( 0 )
      neighbor_2d_stats ( step, m, n, c1, c5 );
    end

    if ( 0 )
      neighbor_2d_display ( step, m, n, c1, c5 );
    end
%
%  Determine the chances of flipping cell (I,J).
%
    threshhold = zeros ( m, n );

    for j = 1 : 5
      i = find ( c5 == j );
      threshhold(i) = prob(j);
    end

    [ r, seed ] = r8mat_uniform_01 ( m, n, seed );

    i = find ( r < threshhold );

    c1(i) = - c1(i);

    ising_2d_stats ( step, m, n, c1 );
    ising_2d_display ( step, m, n, c1 );

  end

  return
end


function spline_test05 ( )

%*****************************************************************************80
%
%% TEST05 tests BASIS_MATRIX_BEZIER, BASIS_MATRIX_TMP.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 February 2009
%
%  Author
%
%    John Burkardt
%
  n = 4;
  ndata = 4;
  nsample = 4;
  tdata = [ 0.0E+00, 0.0E+00, 1.0E+00, 1.0E+00 ]';
  ydata = [ 7.0E+00,  8.3333333E+00,   10.0E+00, 12.0E+00 ]';

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST05\n' );
  fprintf ( 1, '  BASIS_MATRIX_BEZIER sets up the basis\n' );
  fprintf ( 1, '    matrix for the uniform Bezier spline.\n' );

  mbasis = basis_matrix_bezier ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, '    TDATA, YDATA\n' );
  fprintf ( 1, '\n' );
  for i = 1 : ndata
    fprintf ( 1, '%12f  %12f\n', tdata(i), ydata(i) );
  end

  left = 2;

  fprintf ( 1, '\n' );
  fprintf ( 1, '    T, Spline(T)\n' );
  fprintf ( 1, '\n' );

  for i = 0 : ndata

    if ( i == 0 )
      tlo = tdata(1) - 0.5E+00 * ( tdata(2) - tdata(1) );
      thi = tdata(1);
    elseif ( i < ndata )
      tlo = tdata(i);
      thi = tdata(i+1);
    elseif ( ndata <= i )
      tlo = tdata(ndata);
      thi = tdata(ndata) + 0.5E+00 * ( tdata(ndata) - tdata(ndata-1) );
    end

    if ( i < ndata )
      jhi = nsample - 1;
    else
      jhi = nsample;
    end

    for j = 0 : jhi

      tval = ( ( nsample - j ) * tlo   ...
             + (           j ) * thi ) ...
             /   nsample;

      yval = basis_matrix_tmp ( left, n, mbasis, ndata, tdata, ydata, tval );

      if ( 0 < i & j == 0 )
        mark = '*';
      else
        mark = ' ';
      end

      fprintf ( 1, '%c  %12f  %12f\n', mark, tval, yval );

    end

  end

  return
end