spm_BMS_gibbs.m 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  1. function [exp_r,xp,r_samp,g_post] = spm_BMS_gibbs (lme, alpha0, Nsamp)
  2. % Bayesian model selection for group studies using Gibbs sampling
  3. % FORMAT [exp_r,xp,r_samp,g_post] = spm_BMS_gibbs (lme, alpha0, Nsamp)
  4. %
  5. % INPUT:
  6. % lme - array of log model evidences
  7. % rows: subjects
  8. % columns: models (1..Nk)
  9. % alpha0 - [1 x Nk] vector of prior model counts
  10. % Nsamp - number of samples (default: 1e6)
  11. %
  12. % OUTPUT:
  13. % exp_r - [1 x Nk] expectation of the posterior p(r|y)
  14. % xp - exceedance probabilities
  15. % r_samp - [Nsamp x Nk] matrix of samples from posterior
  16. % g_post - [Ni x Nk] matrix of posterior probabilities with
  17. % g_post(i,k) being post prob that subj i used model k
  18. %__________________________________________________________________________
  19. % Copyright (C) 2009-2013 Wellcome Trust Centre for Neuroimaging
  20. % Will Penny
  21. % $Id: spm_BMS_gibbs.m 6381 2015-03-17 17:55:09Z will $
  22. if nargin < 3 || isempty(Nsamp)
  23. Nsamp = 1e4;
  24. end
  25. Ni = size(lme,1); % number of subjects
  26. Nk = size(lme,2); % number of models
  27. % prior observations
  28. %--------------------------------------------------------------------------
  29. if nargin < 2 || isempty(alpha0)
  30. alpha0 = ones(1,Nk);
  31. end
  32. alpha0 = alpha0(:)';
  33. % Initialise; sample r from prior
  34. r = zeros(1,Nk);
  35. for k = 1:Nk
  36. r(:,k) = spm_gamrnd(alpha0(k),1);
  37. end
  38. sr = sum(r,2);
  39. for k = 1:Nk
  40. r(:,k) = r(:,k)./sr;
  41. end
  42. % Subtract max evidence for subject
  43. lme = lme - max(lme,[],2)*ones(1,Nk);
  44. % Gibbs sampling
  45. r_samp = zeros(Nsamp,Nk);
  46. g_post = zeros(Ni,Nk);
  47. for samp = 1:2*Nsamp
  48. mod_vec = sparse(Ni,Nk);
  49. % Sample m's given y, r
  50. for i = 1:Ni
  51. % Pick a model for this subject
  52. u = exp(lme(i,:) + log(r)) + eps;
  53. g = u / sum(u);
  54. gmat(i,:) = g;
  55. modnum = spm_multrnd(g,1);
  56. mod_vec(i,modnum) = 1;
  57. end
  58. % Sample r's given y, m
  59. beta = sum(mod_vec,1);
  60. alpha = alpha0+beta;
  61. for k = 1:Nk
  62. r(:,k) = spm_gamrnd(alpha(k),1);
  63. end
  64. sr = sum(r,2);
  65. for k = 1:Nk
  66. r(:,k) = r(:,k) ./ sr;
  67. end
  68. % Only keep last Nsamp samples
  69. if samp > Nsamp
  70. r_samp(samp-Nsamp,:) = r;
  71. g_post = g_post+gmat;
  72. end
  73. if mod(samp,1e4)==0
  74. fprintf('%d samples out of %d\n',samp,2*Nsamp);
  75. end
  76. end
  77. g_post = g_post/Nsamp;
  78. % Posterior mean
  79. exp_r = mean(r_samp,1);
  80. % Exceedence probs
  81. xp = zeros(1,Nk);
  82. [y,j] = max(r_samp,[],2);
  83. tmp = histc(j,1:Nk)';
  84. xp = tmp / Nsamp;