No BSD License  

Highlights from
Ordinal Data Modeling

image thumbnail
from Ordinal Data Modeling by Valen Johnson
Companion Software

sampleOrdProb(data,K,mle,sampSize)
function [sampleBeta, lat_resid, accept] = sampleOrdProb(data,K,mle,sampSize)
% sampleOrdProb returns a sample from the posterior on the
%   category-cutoffs and regression parameters in an ordinal probit
%   model.  IT IS ASSUMED THAT THE MULTINOMIAL DENOMINATORS ARE ALL 1,
%   or that the row sum of N is a 1 vector.
%   
%   N:		the data matrix, as expected by ordinalMLE.m    
%   X:		design matrix, without indicators for the category-cutoffs.
%   mle:	initial estimate of the vector (\gamma_2, ..., 
%		\gamma_{C-1},\beta_0,...,\beta_p).
%   sampSize:	desired number of MCMC iterates.  
%   sampleBeta: MCMC sample with sampSize rows, and columns 
%		corresponding to the
%		components of mle.  
%   lat_resid:  posterior means of the sorted latent variables.
%   accept:	acceptance ratio for category cutoffs

[N,X]=reformdata(data,K);
h = waitbar(0,'Simulation running ...');

%   Initialize vectors
    [I K] = size(N);
    [p p0] = size(mle); % p should be rank(beta)+K-2
    [I0 a] = size(X);

    if p0 ~= 1
	error('mle should be a vector')
    end

    if I0 ~= I
        error('Design rows doesnt match observation rows')
    end

    if a ~= (p-K+2)
        error('Columns of X do not match mle beta columns')
    end 

    sampleBeta = zeros(sampSize,p);
    lat_resid = zeros(I,1);
    sampleBeta(1,:) = mle';
    std = ones(I,1);
    covB = inv(X'*X);
    sm = 0.8/K;
    g = zeros(K,1);
    oldg = zeros(K,1);
    accept = 0;
    linPred = X*sampleBeta(1,[(K-1):p])';


    for i=1:sampSize
       
       %     1. Sample latent vector Z
%        a) Form linear predictor
                if i~=1
		   i0 = i-1;
	        else
                   i0 = 1;
		end
		linPred = X*sampleBeta(i0,[(K-1):p])';
		
%        b) Form upper and lower truncation points
                upper = sum((N*diag([0 sampleBeta(i0,[1:(K-2)]) ... 
                                     sampleBeta(i0,K-2)+5.0 ]))')';
                lower = sum((N*diag([-10 0 sampleBeta(i0,[1:(K-2)]) ]))')';
%        c) Draw sample
                z = truncNorm(linPred,std,lower,upper);
                lat_resid = lat_resid + sort(z-linPred);

%     2. Sample gamma
%        a) Get proposal gamma in g; the old gamma in oldg
		oldg = [0 sampleBeta(i0,[1:(K-2)]) sampleBeta(i0,K-2)+4]'; 
                g(1) = 0;
                for j=2:(K-1) 
		   g(j) = truncNorm(oldg(j),sm,g(j-1),oldg(j+1));
	        end
	        g(K) = g(K-1)+4;

%        b) Calculate acceptance ratio R
		%   adjust R for proposal density truncation
                R = 1;
		for j=2:(K-1)
		   R = R * ( Phi((oldg(j+1)-oldg(j))/sm) -  ...
                         Phi((g(j-1)-oldg(j))/sm) ) / ... 
                       ( Phi((g(j+1)-g(j))/sm) - ...
                         Phi((oldg(j-1)-g(j))/sm) );
	        end
	        %  multiply in likelihood

                phiYnew = Phi( N*g  - linPred );
                phiYold = Phi( N*oldg - linPred );
		phiYm1new=Phi( N*[-1000 g([1:(K-1)])']' - linPred);
	        phiYm1old=Phi( N*[-1000 oldg([1:(K-1)])']' -linPred);
	        R = R*prod( (phiYnew-phiYm1new)./(phiYold-phiYm1old));

%        c) Accept/reject
                % accept/reject
                if rand < R
                  sampleBeta(i,[1:(K-2)]) = g([2:(K-1)])';
                  accept = accept+1;
		else
		  sampleBeta(i,[1:(K-2)]) = oldg([2:(K-1)])';
                end

  
%     3. Sample beta given Z
                LS = covB * X' * z;
                sampleBeta(i,[(K-1):p]) = rMultiNorm(LS,covB)';
                
                waitbar(i/sampSize)
             end
             
close(h)
  lat_resid = lat_resid/sampSize;
  accept = accept/sampSize;
  
  function val = truncNorm(mu,std,lower,upper)
% truncNorm returns a sample vector of normal deviates with means mu
%     standard deviation std, truncated to the intervals
%     (lower,upper).
%

% Calculate bounds on probabilities
  lowerProb = Phi((lower-mu)./std);
  upperProb = Phi((upper-mu)./std);

% Draw uniform from within (lowerProb,upperProb)
  u = lowerProb+(upperProb-lowerProb).*rand(size(mu));

% Find needed quantiles
  val = mu + Phiinv(u).*std;
  
  
  function y = Phi(x)
% Phi computes the standard normal distribution function value at x
%
y = .5*(1+erf(x/sqrt(2)));

function val=Phiinv(x)
% Computes the standard normal quantile function of the vector x, 0<x<1.
%
val=sqrt(2)*erfinv(2*x-1);

function rnorm = rMultiNorm(mu,cov)
% rMultiNorm generates a random multivariate normal vector.
%
%size(mu);
%size(cov);
%chol(cov);
randn(size(mu));
rnorm = mu +chol(cov)'*randn(size(mu));

function [N,X]=reformdata(data,k)

y=data(:,1);
n=size(data,1);
c=size(data,2);
X=data(:,2:c);
N=zeros(n,k);
for i=1:n
   N(i,y(i))=1;
end

Contact us at files@mathworks.com