function binx = bin(nbin, rgt, binindex, meanwrd)  
  %  Bins values in vector RGT into bins indicated in vector BININDEX
  %  If MEANWRD is T, the value in the bin is the of the RGT values
  %  in the bin, otherwise it is the sum.
  if nargin < 4, meanwrd = 1; end
  binx = zeros(nbin,1);
  binind = unique(binindex);
  
  if meanwrd  
    for i = 1:nbin  
      temp = rgt(binindex==i);
      if length(temp) > 0, binx(i) = mean(temp); end
    end
  else  
    for i = 1:nbin 
      binx(i) =  sum(rgt(binindex==i));
    end
  end

function pmat = bound(pmat, nex)  
   %  replaces probability values in PMAT by 1/(2*NEX) if lower,
   %  or by 1 - 1/(2*NEX) if higher.
   delta = 1/(2*nex);
   pmatdim = size(pmat);
   for j=1:pmatdim(2) 
     index = pmat(:,j) <   delta;
     if any(index), pmat(index,j) =     delta; end
     index = pmat(:,j) > 1-delta;
     if any(index), pmat(index,j) = 1 - delta;  end
   end

function [N, CN, CP, L, CL] = Estep(dichtest, P, wgtq, charwrd)
%  The E step of the EM algorithm
%  dichtest ... N by n matrix of binary item scores
%  P        ... Q by n matrix of probabilities
%  wgtq     ... Q by 1 vector of quadrature weights
%  charwrd  ... if 1 data are in character mode, otherwise numeric

if nargin < 4, charwrd = 1;  end

% get number of examinees and number of items
[nex, nit] = size(dichtest); 
Q = length(wgtq);  %  get number of quadrature weights
%  Compute:
%  CL:  N by Q matrix of conditional likelihoods, 
%  L:   N marginal likelihoods,
%  CP:  N by Q matrix of conditional probabilities, and
%  CN:  n by Q matrix of conditional pseudo-frequencies
CL = zeros(nex,Q);
CP = CL;
CN = zeros(nit,Q);
L  = zeros(nex,1);
logP   = log(P);
log1mP = log(1 - P);
for i=1:nex
    if charwrd
        temp = (double(dichtest(i,:))-48)';
    else
        temp = dichtest(i,:)';
    end
    %notmiss = (temp ~= 2);
    %temp = temp(notmiss);
    %CL(i,:) = exp(logP(:,notmiss)*temp + log1mP(:,notmiss)*(1-temp))';
    CL(i,:) = exp(logP*temp + log1mP*(1-temp))';
    %plot(thetaq,CL(i,:)');   
    L(i) = CL(i,:)*wgtq;
    CP(i,:) = wgtq'.*CL(i,:)./L(i);
    %CN(notmiss,:) = CN(notmiss,:) + temp*CP(i,:);
    CN = CN + temp*CP(i,:);
    %pause
end
%  Compute Q marginal pseudo-frequencies
N = sum(CP);



function P0 = FirstStep(dichtest, thetaq, charwrd)
%  initialize EM algorithm by finding an initial set of probabilities
%  Arguments:
%    dichtest ... a nex by nit matrix of binary item scores
%    thetaq   ... set of quadrature points
%    charwrd  ... if 1, data are in character mode, otherwise numeric
%  Return:
%    P0 ... a nq by nit matrix of proportions 

if nargin < 3, charwrd = 1; end

[nex,nit] = size(dichtest);  % compute no. examinees and no. items
nq = length(thetaq);         %  number of trait values

% we want to make a histogram, with each bin centered
%   on a trait value.  First construct nq+1 boundaries for bars

bounds = zeros(nq+1,1);
bounds(   1) = -1e10;
bounds(nq+1) =  1e10;
for q = 2:nq
  bounds(q) = (thetaq(q-1)+thetaq(q))/2;
end

%  for each examinee, compute the index of the bar or bin
%    containing his quantile value

qscore = norminv((1:nex)./(nex+1), 0, 1);

%  get indices of bins corresponding to quantiles

binindex = zeros(nex,1);
for i=1:nq
  index = (qscore <= bounds(i+1) & qscore > bounds(i));
  binindex(index) = i;
end

%  Get preliminary estimates of IRF's at thetaq values
%  note:  the data play a role here only in terms of the
%  sorting index array, sortindex.  This array sorts the rows of
%  the dichotomous response matrix according to the rank of
%  the number right scores.

%  compute scores on the test

if charwrd
    score = zeros(nex,1);
    for i=1:nex
        temp = double(dichtest(i,:))-48;
        score(i) = sum(temp); 
    end
else
    score = sum(dichtest')'; 
end

%  sscore are the sorted scores, sortindex the indices that
%     sort vector score.  A random normal deviate, mean 0,
%     std. dev. .01 is added to each score before sorting
%     to sort tied values in random order.

[sscore,sortindex] = sort(score+0.01.*randn(nex,1));

%  for each item, compute proportion of examinees in each bin
%  that pass the test using function bin

biny = zeros(nq,nit);   
for j = 1:nit
    if charwrd
        temp = double(dichtest(sortindex,j))-48; 
    else
        temp = dichtest(sortindex,j);
    end
   biny(:,j) = bin(nq, temp, binindex);
end

%  Function bound replaces probability values in biny by 
%  1/(2*NEX) if lower, or by 1 - 1/(2*NEX) if higher.

P0 = bound(biny, nex);



function [wgt, integvec] = gausswgt3(thetaq, nbasis, norder)
%  Quadrature weights for B-spline test functions

%  set up fine mesh for estimating integrals

nq        = length(thetaq);
thetarng  = [min(thetaq), max(thetaq)];
delta     = 1e-3;
thetafine = min(thetaq):delta:max(thetaq);
nfine     = length(thetafine);

%  set up spline basis

norder   = 4;
nbasis   = nq + norder - 2;
basisobj = create_bspline_basis(thetarng, nbasis);

basisnq  = getbasismatrix(thetaq,    basisobj);
basisfin = getbasismatrix(thetafine, basisobj);

%  compute std. normal density values

kernelfn = (exp(-thetafine.^2/2)/sqrt(2*pi))';

%  estimate integrals by trapezoidal rule

integvec = delta.*(basisfin'*kernelfn - 0.5.*(basisfin(1,:)'.*kernelfn(1) + basisfin(nfine,:)'.*kernelfn(nfine)));

%  solve for weights giving least squares solution

wgt = basisnq'\integvec;


function newcoef = Mstep(CN, N, P, coef, phimat, penmat)
%  M-step
%  for each item in turn, minimize criterion Fj with respect to
%    values of coefficients cj
%  CN     ... nit by Q matrix of conditional pseudo frequencies
%  N      ... vector of Q marginal pseudo frequencies
%  P      ... Q by nit matrix of probabilities
%  coef   ... K by nit matrix of coefficients for basis functions
%  phimat ... Q by K matrix of basis function values
%  penmat ... K by K matrix for penalizing coefficient roughness
nit = size(P,2);
newcoef = coef;
iterlim = 10;
for j=1:nit
    cj   = coef(:,j);             % initial coefficients
    pj   = P(:,j); qj = 1-P(:,j); % initial probabilities    
    wj   = diag(pj.*qj.*N');      % initial weights
    CNj  = CN(j,:)';              % "Data" for this item
    resj = CNj - pj.*N';          % initial residuals
    %  initial function value
    Fj = -sum(CNj.*log(pj)+(N'-CNj).*log(qj)) + cj'*penmat*cj;
    %  gradient vector
    Gmat = -phimat' * resj        + 2.*penmat*cj;
    %  Hessian matrix
    Hmat =  phimat' * wj * phimat + 2.*penmat;
    %  search direction
    delta = Hmat \ Gmat;
    %  initial step size along direction
    alpha = 1; 
    Fjnew = Fj + 1;
    %  take step, and if new function value less than old, quit
    %  otherwise halve step and try again.
    %  in any case, stop when step size gets too small
    iter = 0;
    while (Fjnew > Fj & iter <= iterlim)
       iter = iter + 1;
       cjnew = cj - alpha .* delta; % update coefficients
       %  Don't let coefficients get too large in either direction
       cjnew(cjnew > 20) = 20; cjnew(cjnew < -20) = -20;
       % update probabilities
       pjnew = 1./(1+exp(-phimat*cjnew)); qjnew = 1 - pjnew;
       % compute new function value
       Fjnew = -sum(CNj.*log(pjnew)+(N'-CNj).*log(qjnew)) + ...
                 cjnew'*penmat*cjnew;
       %fprintf('%g ', [j, iter, Fjnew, Fj]); fprintf('\n');
       alpha = alpha/2; % halve step size
    end
    newcoef(:,j) = cjnew;   % replace old coefficients by new ones
end



