% function [x_chain, P_chain, info] = mcmc_run(FUN, xi, opt, varargin)
%
% MCMC sample, via Metropolis, at a fixed temperature of 1, using a
% negative log posterior function FUN(x, varargin{:}).
%
% Outputs.
%   x_chain    : gives x values along Markov chain
%   P_chain    : neg log posterior along Markov chain (aka 'val').
%   info       : struct giving any other information.
%
% Inputs.
%   opt        : struct giving Metropolis details:
% opt.nits gives # its to perform
% opt.e gives step length. If hess is given, it gives adjustment relative to hessian.
% opt.hess is estimate of hessian.
% opt.LB,UB are bounds on x (if none given, no bounds used) - col vecs.
% opt.verbosity = 0 (or field absent) gives no feedback, 1 gives some.
%
% 6/4/02 barnett
% 2/1/03 modified for binf to not use globals for history.

function [x_chain, P_chain, info] = mcmc_run(FUN, xi, opt, varargin)

verbosity = 0;
if isfield(opt, 'verbosity')
  verbosity = opt.verbosity;
end

if verbosity>0
  disp(sprintf('\tmcmc_run...'));
end

N = numel(xi);
xi = reshape(xi, [N 1]);   % make col vec

if isfield(opt,'e')
  e = opt.e;
else
  e = 0.05; % default stepsize.
end

% set up completely inclusive bounds if none are given...
if ~isfield(opt,'UB')
  opt.UB = Inf * ones(N,1);
end
if ~isfield(opt,'LB')
  opt.LB = -Inf * ones(N,1);
end

if isfield(opt,'hess')
  [rotate,D] = eig(opt.hess);
  D = diag(D);
  max_dx = 1.0; % the largest jump direction (regularizes singular hessians)
  min_eval = 2 / max_dx^2;
  for i=1:N
    if D(i) < min_eval
      disp(sprintf('\tmcmc_run: hess close to singular, eval(%d) < %g : clipping!',i,min_eval));
      D(i) = min_eval;
    end
  end
  stretch = e * diag(sqrt(2 ./ D)); % use e as stepsize adjustment factor.
else
  % default is spherical sampling
  rotate = eye(N);
  stretch = e * eye(N);
end

x_chain = zeros(N, opt.nits);
P_chain = zeros(1, opt.nits);
rej = 0;
x = xi;
val = feval(FUN, x, varargin{:}); % the current value

cubes = 0;
cube_tries = 0; % keep track of attempts to sample
bounds = 0;
bound_tries = 0;

for i = 1:opt.nits
  
  x_try = opt.UB + 1; % make choice guaranteed to be rejected...
  while sum(~(x_try<opt.UB)) + sum(~(x_try>opt.LB)) > 0
    % while you're outside bounds make random jump... of unit length!
    dx = ones(N,1); % start with case guaranteed to be outside N-sphere.
    while dx'*dx > 1 % reject outside N-sphere (watch out for high N!)
      dx = 2*rand(N,1) - 1; % sample from cube, [-1,1] in each dimension.
      cube_tries = cube_tries + 1;
    end 
    cubes = cubes + 1;
    % dx = dx / norm(dx);  % make unit length - optional
    % transform into hessian basis...
    dx = rotate * stretch * dx;
    x_try = x + dx;
    bound_tries = bound_tries + 1;
  end
  bounds = bounds + 1;
  
  val_try = feval(FUN, x_try, varargin{:});
  
  % decide if to accept...
  if rand<exp(-(val_try-val))
    x = x_try;
    val = val_try;
  else
    rej = rej + 1;
  end
  % whether accepted or not, add current position to chain...
  x_chain(:, i) = x;
  P_chain(i) = val;
  
  if verbosity>1 | (verbosity==1 & mod(i,50)==0)
    % feedback from each iteration...
    disp([sprintf('\t%d: obj( ',i),sprintf('%.3f ',x),sprintf(') = %.3f',val)]);
    disp(sprintf('\t\trej: %d/%d = %f', rej, i, rej/i));
  end
end

info.funcCount = opt.nits;
info.r = rej / opt.nits;  % rejection ratio.
info.bound_acc = bounds/bound_tries;
info.cube_acc = cubes/cube_tries;
if verbosity>0
    disp(sprintf('\tmetropolis rejection ratio = %f',info.r));
    disp(sprintf('\tcube-sphere acceptance ratio = %f',info.cube_acc));
    disp(sprintf('\tbounds acceptance ratio = %f',info.bound_acc));
end

% end