THE AUDITORY MODELING TOOLBOX

Applies to version: 0.10.0

View the help

Go to function

EXP_BAUMGARTNER2017 - - Experiments of Baumgartner et al. (2017)

Program code:

function data = exp_baumgartner2017(varargin)
%EXP_BAUMGARTNER2017 - Experiments of Baumgartner et al. (2017)
%   Usage: data = exp_baumgartner2017(flag) 
%
%   EXP_BAUMGARTNER2017(flag) reproduces figures of the study from 
%   Baumgartner et al. (2017).
%
%   The following flags can be specified
%
%     boyd2012 models experiments from Boyd et al. (2012; Fig.1, top).
%         Average externalization ratings of 1 talker for NH participants 
%         against mix point as a function of microphone position (ITE/BTE) 
%         and frequency response (BB/LP). The reference condition (ref) is 
%         the same as ITE/BB. Error bars show SEM. 
%
%     hartmann1996 models experiments from Hartmann & Wittenberg (1996; Fig.7-8)
%         1st panel: Synthesis of zero-ILD signals. Only the harmonics 
%         from 1 to nprime had zero interaural level difference; 
%         harmonics above nprime retained the amplitudes of the baseline  
%         synthesis. Externalization scores as a function of the boundary  
%         harmonic number nprime. Fundamental frequency of 125 Hz.
%         2nd panel: Synthesis of signals to test the ISLD hypothesis. 
%         Harmonics at and below the boundary retained only the interaural 
%         spectral level differences of the baseline synthesis. Higher 
%         harmonics retained left and right baseline harmonic levels. 
%         Externalization scores as a function of the boundary
%         frequency.
%
%     hassager2016 models experiments from Hassager et al. (2016; Fig.6). 
%         The mean of the seven listeners perceived sound source 
%         location (black) as a function of the bandwidth factor 
%         and the corresponding model predictions (colored). 
%         The model predictions have been shifted slightly to the right 
%         for a better visual interpretation. The error bars are one 
%         standard error of the mean.
%
%     baumgartner2017 models experiments from Baumgartner et al. (2017). 
%         Effect of HRTF spectral contrast manipulations on sound externalization. 
%         Externalization scores were derived from paired comparisons via 
%         Bradley-Terry-Luce modeling.
%
%   Requirements: 
%   -------------
%
%   1) SOFA API v0.4.3 or higher from http://sourceforge.net/projects/sofacoustics for Matlab (in e.g. thirdparty/SOFA)
% 
%   2) Data in hrtf/baumgartner2017
%
%   3) Statistics Toolbox for Matlab (for some of the figures)
%
%   Examples:
%   ---------
%
%   To display results for Fig.1 from Boyd et al. (2012) use :
%
%     exp_baumgartner2017('boyd2012');
%
%   To display results for Fig.7-8 from Hartmann & Wittenberg (1996) use :
%
%     exp_baumgartner2017('hartmann1996');
%
%   To display results for Fig.6 from Hassager et al. (2016) use :
%
%     exp_baumgartner2017('hassager2016');
%
%   References:
%     R. Baumgartner, P. Majdak, H. Colburn, and B. Shinn-Cunningham.
%     Modeling sound externalization based on listener-specific spectral
%     cues. In Acoustics ‘17 Boston: The 3rd Joint Meeting of the Acoustical
%     Society of America and the European Acoustics Association, Boston, MA,
%     Jun 2017.
%     
%     A. W. Boyd, W. M. Whitmer, J. J. Soraghan, and M. A. Akeroyd. Auditory
%     externalization in hearing-impaired listeners: The effect of pinna cues
%     and number of talkers. J. Acoust. Soc. Am., 131(3):EL268--EL274, 2012.
%     [1]arXiv | [2]www: ]
%     
%     W. M. Hartmann and A. Wittenberg. On the externalization of sound
%     images. J. Acoust. Soc. Am., 99(6):3678--88, June 1996.
%     
%     References
%     
%     1. http://arxiv.org/abs/ http://dx.doi.org/10.1121/1.3687015
%     2. http://dx.doi.org/10.1121/1.3687015
%     
%   hassager2016 baumgartner2017
%
%   Url: http://amtoolbox.sourceforge.net/amt-0.10.0/doc/experiments/exp_baumgartner2017.php

% Copyright (C) 2009-2020 Piotr Majdak and the AMT team.
% This file is part of Auditory Modeling Toolbox (AMT) version 0.10.0
%
% 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/>.
   
% AUTHOR: Robert Baumgartner, Acoustics Research Institute, Vienna, Austria

definput.import={'amt_cache','baumgartner2017'};
definput.flags.type = {'missingflag','boyd2012','hartmann1996','hassager2016','baumgartner2017'};
definput.flags.quickCheck = {'','quickCheck'};
definput.keyvals.Sintra = 2;
definput.keyvals.Sinter = 2;
definput.keyvals.Interaction = {'MSG','ITIT'};

[flags,kv]  = ltfatarghelper({},definput,varargin);

if flags.do_missingflag
  flagnames=[sprintf('%s, ',definput.flags.type{2:end-2}),...
             sprintf('%s or %s',definput.flags.type{end-1},definput.flags.type{end})];
  error('%s: You must specify one of the following flags: %s.',upper(mfilename),flagnames);
end

Ncues = 7;
% Symbol order for plotting
symb = {'-o','-s','-d','-<','->','-^','-v','-p',':*','--x'};
colors = 0.8*[zeros(1,3);hsv(Ncues+2)];
InteractionLbl = [kv.Interaction{1},' x ',kv.Interaction{2}];

%% Hassager et al. (2016)
if flags.do_hassager2016
  azi = [0,50];
  flp = 6000; % lowpass filtered noise stimuli
  
  Pext_A = data_hassager2016;
  B = Pext_A.B;
  
  fncache = ['hassager2016'];
  [Pext,cues,cueLbl] = amt_cache('get',fncache,flags.cachemode);
  if isempty(cues)
    
    data = data_baumgartner2017;
    if flags.do_quickCheck
      data = data(1:5);
    end

%     Pext = nan(length(B),length(data),length(azi));
%     Pext = {Pext,Pext};
    cues = nan(length(B),length(azi),length(data),Ncues);
    for isubj = 1:length(data)
      Obj = data(isubj).Obj;
      for iazi = 1:length(azi)
        idazi = Obj.SourcePosition(:,1) == azi(iazi) & Obj.SourcePosition(:,2) == 0;
        template = squeeze(shiftdim(Obj.Data.IR(idazi,:,:),2));
        for iB = 1:length(B)
          amt_disp(num2str(iB),'volatile');
          if isnan(B(iB))
            target = template;
          else
            Obj_tar = sig_hassager2016(Obj,B(iB));
            target = squeeze(shiftdim(Obj_tar.Data.IR(idazi,:,:),2));
          end
          [~,cues(iB,iazi,isubj,:),cueLbl] = baumgartner2017(target,template,'flow',100,'fhigh',flp,'lat',azi(iazi));
        end
      end
      amt_disp([num2str(isubj),' of ',num2str(length(data)),' subjects completed.'],'progress')
    end
     
    if not(flags.do_quickCheck)
      amt_cache('set',fncache,Pext,cues,cueLbl);
    end
  end
  
  %% Cue weighting optimization procedure
  dimSubj = 3;
  dimCues = 4;
  Nsubj = size(cues,dimSubj);

  cues = num2cell(cues,1:dimCues-1);
  % optimize sensitivities
%   predCue = reshape(cues,length(B)*length(azi)*Nsubj,Ncues);
  actual = repmat(Pext_A.rating(:),Nsubj,1);
  Erange = 4;
  Eoffset = 1;
  InteractionIds = find(ismember(cueLbl(:,1),kv.Interaction));
  [S,W,Pext,dE] = cueWeightOpti(cues,actual,Erange,Eoffset,InteractionIds);
  
  PextLbl = [cueLbl(:,1);{'Comb.'};{InteractionLbl}];
  
  cueTab = table([S;nan(2,1)],dE,[W;nan(2,1)],[cueLbl(:,2);{'Weighted combination'};{[InteractionLbl, ' interaction']}],...
    'RowNames',PextLbl,...
    'VariableNames',{'Sensitivity','Error','Weight','Description'});
  amt_disp(flags.type)
  amt_disp(cueTab)
  
  %% Plot
  BplotTicks = logspace(log10(0.25),log10(64),9);
  BplotTicks = round(BplotTicks*100)/100;
  BplotStr = ['Ref.';num2str(BplotTicks(:))];
  BplotTicks = [BplotTicks(1)/2,BplotTicks];
  B(1) = B(2)/2;
  dataLbl = [{'Actual'};PextLbl];
  idleg = not(ismember(dataLbl,'ITSD'));
  figure 
  hax = tight_subplot(1,2,0,[.15,.1],[.1,.05]);
  for iazi = 1:length(azi)
%     subplot(1,2,iazi)
    axes(hax(iazi))
    h(1) = plot(B,Pext_A.rating(:,iazi),symb{1},'Color',colors(1,:));
    hold on
    for m = 1:length(Pext)
      dx = 1+0.02*(m - (Ncues+1)/2);
      h(m+1) = errorbar(dx*B,mean(Pext{m}(:,iazi,:),dimSubj),std(Pext{m}(:,iazi,:),0,dimSubj)/sqrt(Nsubj),...
        symb{m+1},'Color',colors(m+1,:));
    end
    set(h,'MarkerFaceColor','w')
    set(gca,'XTick',BplotTicks,'XTickLabel',BplotStr,'XScale','log')
    axis([BplotTicks(1)/1.5,BplotTicks(end)*1.5,0.8,5.2])
    xlabel('Bandwidth Factor [ERB]')
    if iazi==1
      ylabel('Mean Externalization Rating')
    else
      set(gca,'YTickLabel',{})
    end
    title([num2str(azi(iazi)),'\circ'])
  end
  leg = legend(h(idleg),dataLbl(idleg),'Location','southwest');
  set(leg,'Box','off')
  
  %% Output
  data = {cueTab,Pext};
  
end

%% Hartmann & Wittenberg (1996)
if flags.do_hartmann1996
  
  cond = {'ILD','ISLD'};
  condPlotLbl = {'ILD to 0','ILD const.'};
  nprime = [0,1,8,14,19,22,25,38];
  
  fncache = ['hartmann1996'];
  [Pext,cues,cueLbl] = amt_cache('get',fncache,flags.cachemode);
  if isempty(Pext)
    azi = -37;
    data = data_baumgartner2017;
    if flags.do_quickCheck
      data = data(1:5);
    end
    Pext = repmat({nan(length(data),length(nprime))},2,2);
    cues = repmat({nan(length(data),length(nprime),Ncues)},2,1);
    for isub = 1:length(data)
      Obj = data(isub).Obj;
      template = sig_hartmann1996(0,'Obj',Obj,'dur',0.1);
      for ee = 1:length(cond)
        for nn = 1:length(nprime)
          target = sig_hartmann1996(nprime(nn),'Obj',Obj,'dur',0.1,cond{ee});
          [~,cues{ee}(isub,nn,:),cueLbl] = baumgartner2017(target,template,'flow',100,'fhigh',5000,'lat',azi);
        end
      end
      amt_disp([num2str(isub),' of ',num2str(length(data)),' subjects completed.'],'progress')
    end
    if not(flags.do_quickCheck)
      amt_cache('set',fncache,Pext,cues,cueLbl);
    end
  end
  
  %% Cue weighting optimization procedure
  
  % align actual and modeled data format
  actual = [];
  predCue = [];
  for ee = 1:length(cond)
    act = data_hartmann1996(cond{ee});
    actual = cat(1,actual,act.avg.Escore(:));
    tmp = squeeze(mean(cues{ee},1));
    tmp = interp1(nprime,tmp,act.avg.nprime);
    predCue = cat(1,predCue,tmp);
  end
  predCue = num2cell(predCue,1);
  
  
  Erange = 3;
  Eoffset = 0;
  InteractionIds = find(ismember(cueLbl(:,1),kv.Interaction));
  if length(InteractionIds) ~=2
    error('RB: Check interaction labels.')
  end
  [S,W,~,dE] = cueWeightOpti(predCue,actual,Erange,Eoffset,InteractionIds);
  % calculate separate errors for Exp 1 and 2
  dE1 = nan(size(dE));
  dE2 = nan(size(dE));
  for ss = 1:length(S)
    E = cue2E(S(ss),predCue{ss},Erange,Eoffset);
    dE1(ss) = nanrms(E(1:5)-actual(1:5)) / (Erange-Eoffset);
    dE2(ss) = nanrms(E(6:9)-actual(6:9)) / (Erange-Eoffset);
  end
  
  PextLbl = [cueLbl(:,1);{'Comb.'};{InteractionLbl}];
  
  cueTab = table([S;nan(2,1)],dE1,dE2,dE,[W;nan(2,1)],[cueLbl(:,2);{'Weighted combination'};{[InteractionLbl, ' interaction']}],...
    'RowNames',PextLbl,...
    'VariableNames',{'Sensitivity','ErrorExp1','ErrorExp2','Error','Weight','Description'});
  amt_disp(flags.type)
  amt_disp(cueTab)

  %% Individual data
  dimCues = 3;
%   Ncues = size(cues{1},dimCues);
  Pext = cell(Ncues+1,length(cond));
  for ee = 1:length(cond)
    for cc = 1:Ncues
      Pext{cc,ee} = cue2E(S(cc),cues{ee}(:,:,cc),Erange,Eoffset);
    end
    Pext{Ncues+1,ee} = W(1)*Pext{1,ee};
    for cc = 2:Ncues
      Pext{Ncues+1,ee} = nansum(cat(dimCues,Pext{Ncues+1,ee},W(cc)*Pext{cc,ee}),dimCues);
    end
    Pext{Ncues+2,ee} = sqrt(Pext{InteractionIds(1),ee}.*Pext{InteractionIds(2),ee}); % interaction term
  end
  
  %% Plot
  dataLbl = [{'Actual'};PextLbl];
  idleg = not(ismember(dataLbl,'ITSD'));
  Ns = size(Pext{1},1);
  figure
  hax = tight_subplot(1,2,0,[.15,.1],[.1,.05]);
  for ee = 1:length(cond)
    act = data_hartmann1996(cond{ee});
%     subplot(1,2,ee)
    axes(hax(ee))
    h(1) = plot(act.avg.nprime,act.avg.Escore,symb{1},'Color',colors(1,:));
    hold on
    for cc = 1:size(Pext,1)
      if idleg(cc+1)
        dx = 0.1*(cc - size(Pext,1)/2);
        h(cc+1) = errorbar(nprime+dx,mean(Pext{cc,ee}),std(Pext{cc,ee})/sqrt(Ns),...
          symb{cc+1},'Color',colors(cc+1,:));
      end
    end
    set(h(idleg),'MarkerFaceColor','w')
    if ee == 1
      xlabel('n^{\prime} (Highest harmonic with ILD = 0)')
      ylabel('Externalization score')
    else
      xlabel('n^{\prime} (Highest harmonic with altered amplitudes)')
      set(gca,'YTickLabel',{})
    end
    title(condPlotLbl{ee})
    axis([-2.5,42.5,-0.4,3.9])
    idx = false(size(idleg));
    if ee == 1
      idx(1:Ncues) = true;
    else
      idx(Ncues+1:end) = true;
    end
    legend(h(and(idleg,idx)),dataLbl(and(idleg,idx)),'Location','southwest','box','off');
  end
  
  % Output
  data = {cueTab,Pext};
end

%% Boyd et al. (2012) -----------------------------------------------------
if flags.do_boyd2012
  
  flags.do_noise = false;
  flags.do_georganti2013 = false;
  flags.do_BRIR = true;
  
  flp = [nan,6500]; % Low-pass cut-off frequency
  azi = -30;
  
  subjects = data_boyd2012;
  if flags.do_noise || flags.do_BRIR
    subjects = subjects([3,6,7]); % only the ones with BRIRs
  else
    subjects = subjects([1,3,4,6,7]); % only the ones with stimuli
  end
%   fprintf(['Note that only 3 of originally 7 listeners are simulated and compared because\n',...
%     'the listener-specific BRIRs for the other 4 listeners are not available.\n'])
  mix = subjects(1).Resp.mix/100;
    
  fncache = ['boyd2012_lp'];
  [E,cues,cueLbl] = amt_cache('get',fncache,flags.cachemode);
  if isempty(cues)
    
    mix(1) = 1;

    if flags.do_noise || flags.do_BRIR
      sig = noise(50e3,1,'pink');
      fs = subjects(1).BRIR.fs;
      [b,a]=butter(10,2*flp(2)/fs,'low');
    end

    E.meta = {'actual','interaural','monaural'};
    if flags.do_georganti2013
      E.meta(4) = {'BSMD'};
    end
    E.all = repmat({nan([length(mix),2,2,length(subjects)])},1,length(E.meta));
    cues = nan(length(mix),2,2,length(subjects),Ncues);
    for isub = 1:length(subjects)
      E.all{1}(:,:,:,isub) = cat(3,...
        [subjects(isub).Resp.ITE_BB_1T(:),subjects(isub).Resp.BTE_BB_1T(:)],...
        [subjects(isub).Resp.ITE_LP_1T(:),subjects(isub).Resp.BTE_LP_1T(:)]);
%       ITE = subjects(isub).Obj;
      if flags.do_noise
        stim{1} = lconv(sig,subjects(isub).BRIR.ITE(:,:,1));
        stim{2} = lconv(sig,subjects(isub).BRIR.BTE(:,:,1));
        stim{3} = lconv(sig,subjects(isub).BRIR.noHead(:,:,1));
        template = stim{1};
        targetSet = cell(length(mix),2,2);
      elseif flags.do_BRIR
        template = subjects(isub).BRIR.ITE(:,:,1);
        stim{1} = subjects(isub).BRIR.ITE(:,:,1);
        stim{2} = subjects(isub).BRIR.BTE(:,:,1);
        stim{3} = subjects(isub).BRIR.noHead(:,:,1);
        targetSet = cell(length(mix),2,2);
      else % speech samples
        template = subjects(isub).Reference_1T;
        targetSet = cat(3,...
          [subjects(isub).Target.ITE_BB_1T(:),subjects(isub).Target.BTE_BB_1T(:)],...
          [subjects(isub).Target.ITE_LP_1T(:),subjects(isub).Target.BTE_LP_1T(:)]);
        targetSet = [repmat({template},[1,2,2]);targetSet];
      end

      %% Model simulations
      flow = 100;
      fhigh = [16e3,flp(2)];
            
      for c = 1:2
        for lp = 1:2
          for m = 1:length(mix)
            if m==1 && (c~=1 || lp~=1) % same reference condition
              for ee = 2:length(E.all)
                E.all{ee}(m,c,lp,isub) =  E.all{ee}(m,1,1,isub);
                targetSet{m,c,lp} = targetSet{m,1,1};
              end
            else
  %             target{m,c,lp} = sig_boyd2012(stim{c},sig,mix(m),flp(lp),fs);
              % mixing
              if flags.do_noise || flags.do_BRIR
                targetSet{m,c,lp} = mix(m)*stim{c} + (1-mix(m))*stim{3};
                % low-pass filtering
                if lp == 2
                  targetSet{m,c,lp} = filter(b,a,targetSet{m,c,lp});
                end
              end
              target = targetSet{m,c,lp};
  % % Description in paper is ambiguous about whether broadband ILDs were
  % % adjusted to the template:
  %           temSPL = dbspl(template); 
  %             for ch = 1:2
  %               target{m,c,lp}(:,ch) = setdbspl(target{m,c,lp}(:,ch),temSPL(ch));
  %             end
              amt_disp(num2str(mix(m)),'volatile')
              if flags.do_BRIR
                flags.do_spectralCueEchoSuppression = true;
              end
              [~,cues(m,c,lp,isub,:),cueLbl] = baumgartner2017(target,template...
                ,'argimport',flags,kv,'flow',flow,'fhigh',fhigh(1),'lat',azi,'reflectionOnsetTime',5e-3); % replace fhigh(1) with fhigh(lp) for manual bandwidth adjustment

              if flags.do_georganti2013
                geor.fs = subjects(1).fs;
                geor.timeFr = 1;
                geor.fmin = flow;
                geor.fmax = fhigh(lp);
                E.all{4}(m,c,lp,isub) = median(georganti2013(target,geor)); % median over time
              end
              
            end
          end
        end
      end
      amt_disp([num2str(isub),' of ',num2str(length(subjects)),' subjects completed.'],'progress')

    end

    if flags.do_georganti2013
      E.all{4} = 100*E.all{4}./repmat(E.all{4}(1,1,1,:),[length(mix),2,2,1]);
    end
    
    if not(flags.do_quickCheck)
      amt_cache('set',fncache,E,cues,cueLbl);
    end
  end

  
  %% Cue weighting optimization procedure
  dimSubj = 4;
  dimCues = 5;
  Erange = 100;
  Eoffset = 0;
  
  Nsubj = size(cues,dimSubj);
  if flags.do_BRIR % comparison on individual basis
    actual = E.all{1};
  else % average comparison
    actual = repmat(mean(E.all{1},4),[ones(1,Nsubj-1),Nsubj]);
  end
  
  cuesC = squeeze(num2cell(cues,1:dimCues-1));
  InteractionIds = find(ismember(cueLbl(:,1),kv.Interaction));
  [S,W,Pext,dE] = cueWeightOpti(cuesC,actual,Erange,Eoffset,InteractionIds);
  
  E.all(2:Ncues+3) = Pext;
  
  PextLbl = [cueLbl(:,1);{'Comb.'};{InteractionLbl}];
  
  cueTab = table([S;nan(2,1)],dE,[W;nan(2,1)],[cueLbl(:,2);{'Weighted sum'};{[InteractionLbl, ' interaction']}],...
    'RowNames',PextLbl,...
    'VariableNames',{'Sensitivity','Error','Weight','Description'});
  amt_disp(flags.type)
  amt_disp(cueTab)
  
  %% Average data
  for ee = 1:length(E.all)
    E.m{ee} = mean(E.all{ee},4);
    E.se{ee} = std(E.all{ee},0,4);
  end
  
  %% Plot
  flags.do_plot_individual = false;
  
  condLbl = {'ITE / BB','BTE / BB','ITE / LP','BTE / LP'};
  mix = mix(2:end)*100;
  
  leglbl = [{'Actual'};PextLbl];
  idleg = not(ismember(leglbl,'ITSD'));
  if not(flags.do_plot_individual)
    figure
    hax = tight_subplot(2,2,0,[.15,.1],[.1,.05]);
    for cc = 1:length(condLbl)
      axes(hax(cc))
      for ee = 1:length(E.m)
        if idleg(ee)
          dx = 2*(ee - length(E.m)/2);
          h = errorbar(mix+dx,E.m{ee}(2:end,cc),E.se{ee}(2:end,cc),...
            symb{ee},'Color',colors(ee,:));
          set(h,'MarkerFaceColor','w')
          hold on
        end
      end
      set(gca,'XDir','reverse')

      if cc == 3 || cc == 4
        xlabel('Mix (%)')
      else
        set(gca,'XTickLabel',[])
      end

      if cc == 1 || cc == 3
        ylabel('Externalization score')
      else
        set(gca,'YTickLabel',[])
      end
%       title(condLbl{cc})
      text(110,0,condLbl{cc})
      axis([-20,120,-15,115])
      if cc == 4
%         leg = legend(leglbl(idleg));
%         set(leg,'Box','off','Location','eastoutside')
      end
    end
    
  else % flags.do_plot_individual
    
    for isub = 1:size(E.all{1},4)
      figure
      hax = tight_subplot(1,4,0,[.15,.1],[.1,.05]);
      for cc = 1:length(condLbl)
        axes(hax(cc))
        for ee = 1:Nee
          Eisub = E.all{ee}(:,:,:,isub);
          h = plot(mix,Eisub(2:end,cc),symb{ee},'Color',colors(ee,:));
          set(h,'MarkerFaceColor','w')
          hold on
        end
        set(gca,'XDir','reverse')
        xlabel('Mix (%)')
        if cc == 1
          ylabel('Externalization score')
        else
          set(gca,'YTickLabel',[])
        end
        title(condLbl{cc})
        axis([-20,120,-5,105])
        if cc == 4
          leg = legend(dataLbl);
          set(leg,'Box','off','Location','north')
        end
      end
    end
    
  end
%   set(leg,'Location','eastoutside','Position',get(leg,'Position')+[.1,.2,0,0])

%% Output
data = {cueTab,E};

end

if flags.do_baumgartner2017
  
  % Behavioral results
  fncache = 'baumgartner2017_E_BTL';
  data = amt_cache('get',fncache,flags.cachemode);
  if isempty(data)
    exp2 = data_baumgartner2017looming('exp2');
    Nsubj = length(exp2.meta.subject);
    iISI = exp2.meta.ISI == 0.1;
    iresp = strcmp(exp2.meta.response,'approaching');
    A = {1;2;3}; % arbitrary indices to define BTL model
  %   Alabel = {'C = 0','C = 0.5','C = 1'};
    data.C = 0:0.5:1;
    data.subj = [];%exp2.meta.subject;
    data.Escore = [];%nan(Nsubj,length(A));
    data.BTL_chistat = [];%nan(Nsubj,1);
    data.azi = [exp2.rawData.azimuth];
    M = zeros(3,3);
    iM = [7,4,8,3,2,6];
    iss = 0;
    for ss = 1:Nsubj
      M(iM) = exp2.data(ss,1:6,iresp,iISI)+eps;
      [E,chistat,~,lL] = OptiPt(M,A);
      if chistat(1) < 10 && chistat(1) > 0.001
        iss = iss+1;
        data.subj{iss} = exp2.meta.subject{ss};
        data.BTL_chistat(iss) = chistat(1);
        data.BTL_logLikeli(iss) = lL;
        data.Escore(iss,:) = E/E(3);
      end
    end 
    amt_cache('set',fncache,data)
  end
  Nsubj = length(data.subj);
  
  hrtf = data_baumgartner2017looming('exp2','hrtf');
  
  % Modeling
  fncache = ['baumgartner2017'];
  [Pext,cues,cueLbl] = amt_cache('get',fncache,flags.cachemode);
  if isempty(cues)
    
    Pext = nan(length(data.C),Nsubj);
    cues = nan(length(data.C),Nsubj,Ncues);
    for isubj = 1:Nsubj
      template = hrtf(ismember({hrtf.id},data.subj(isubj))).Obj;
      for iC = 1:length(data.C)
        target = sig_baumgartner2017looming(template,data.C(iC));
        [~,cues(iC,isubj,:),cueLbl] = baumgartner2017(target,template,...
                          'lat',data.azi(isubj),'flow',1000,'fhigh',18e3);
        
      end
      amt_disp([num2str(isubj),' of ',num2str(Nsubj),' subjects completed.'],'progress')
    end
    amt_cache('set',fncache,Pext,cues,cueLbl);
  end
 
  %% Cue weighting optimization procedure
  dimSubj = 2;
  dimCues = 3;
  Erange = 1;
  Eoffset = 0;
  
  Nsubj = size(cues,dimSubj);
  actual = permute(data.Escore,[2,1]);
  
  cuesC = squeeze(num2cell(cues,1:dimCues-1));
  InteractionIds = find(ismember(cueLbl(:,1),kv.Interaction));
  [S,W,Pext,dE] = cueWeightOpti(cuesC,actual,Erange,Eoffset,InteractionIds);
  
  PextLbl = [cueLbl(:,1);{'Comb.'};{InteractionLbl}];
  
  cueTab = table([S;nan(2,1)],dE,[W;nan(2,1)],[cueLbl(:,2);{'Weighted sum'};{[InteractionLbl, ' interaction']}],...
    'RowNames',PextLbl,...
    'VariableNames',{'Sensitivity','Error','Weight','Description'});
  amt_disp(flags.type)
  amt_disp(cueTab)
  
  %% Figure
  flags.do_plot_individual = false;
  E_all = [{data.Escore'};Pext];
  dataLbl = [{'Actual'};PextLbl];
  figure
  if not(flags.do_plot_individual)
    for iE = 1:length(E_all)
      dx = 0.01*(iE - length(E_all)/2);
      h(iE) = errorbar(data.C+dx,mean(E_all{iE},2),std(E_all{iE},0,2)/sqrt(Nsubj),...
        symb{iE},'Color',colors(iE,:));
      set(h,'MarkerFaceColor','w')
      hold on
    end
    set(gca,'XTick',data.C)
    axis([-0.2,1.2,-0.1,1.1])
    ylabel('Externalization')
    xlabel('Spectral contrast, C')
  else % flags.do_plot_individual
    for isubj = 1:Nsubj
      subplot(3,ceil(Nsubj/3),isubj)
      for iE = 1:length(E_all)
        dx = 0.01*(iE - length(E_all)/2);
        h(iE) = plot(data.C+dx,E_all{iE}(:,isubj),...
          symb{iE},'Color',colors(iE,:));
        set(h,'MarkerFaceColor','w')
        hold on
      end
      set(gca,'XTick',data.C)
      axis([-0.2,1.2,-0.1,1.1])
      ylabel('Externalization')
      xlabel('Spectral contrast, C')
    end
  end
  idleg = not(ismember(dataLbl,'ITSD'));
  legend(h(idleg),dataLbl(idleg),'Location','EastOutside','box','off')

  %% Output
  data = {cueTab,Pext};
  
end




end

%%%%%%%%%% INTERNAL FUNCTIONS FOR VISUALIZATION %%%%%%%%%%
function ha = tight_subplot(Nh, Nw, gap, marg_h, marg_w)

% tight_subplot creates "subplot" axes with adjustable gaps and margins
%
% ha = tight_subplot(Nh, Nw, gap, marg_h, marg_w)
%
%   in:  Nh      number of axes in hight (vertical direction)
%        Nw      number of axes in width (horizontaldirection)
%        gap     gaps between the axes in normalized units (0...1)
%                   or [gap_h gap_w] for different gaps in height and width 
%        marg_h  margins in height in normalized units (0...1)
%                   or [lower upper] for different lower and upper margins 
%        marg_w  margins in width in normalized units (0...1)
%                   or [left right] for different left and right margins 
%
%  out:  ha     array of handles of the axes objects
%                   starting from upper left corner, going row-wise as in
%                   going row-wise as in
%
%  Example: ha = tight_subplot(3,2,[.01 .03],[.1 .1],[.1 .1])
%           for ii = 1:6; axes(ha(ii)); plot(randn(10,ii)); end
%           set(ha(1:4),'XTickLabel',''); set(ha,'YTickLabel','')

% Pekka Kumpulainen 20.6.2010   @tut.fi
% Tampere University of Technology / Automation Science and Engineering


if nargin<3; gap = .02; end
if nargin<4 || isempty(marg_h); marg_h = .05; end
if nargin<5; marg_w = .05; end

if numel(gap)==1; 
    gap = [gap gap];
end
if numel(marg_w)==1; 
    marg_w = [marg_w marg_w];
end
if numel(marg_h)==1; 
    marg_h = [marg_h marg_h];
end

axh = (1-sum(marg_h)-(Nh-1)*gap(1))/Nh; 
axw = (1-sum(marg_w)-(Nw-1)*gap(2))/Nw;

py = 1-marg_h(2)-axh; 

ha = zeros(Nh*Nw,1);
ii = 0;
for ih = 1:Nh
    px = marg_w(1);
    
    for ix = 1:Nw
        ii = ii+1;
        ha(ii) = axes('Units','normalized', ...
            'Position',[px py axw axh], ...
            'XTickLabel','', ...
            'YTickLabel','');
        px = px+axw+gap(2);
    end
    py = py-axh-gap(1);
end
end

function [p,chistat,u,lL_eba,lL_sat,fit,cova] = OptiPt(M,A,s)
% OptiPt parameter estimation for BTL/Pretree/EBA models
%   p = OptiPt(M,A) estimates the parameters of a model specified
%   in A for the paired-comparison matrix M. M is a matrix with
%   absolute frequencies. A is a cell array.
%
%   [p,chistat,u] = OptiPt(M,A) estimates parameters and reports
%   the chi2 statistic as a measure of goodness of fit. The vector
%   of scale values is stored in u.
%
%   [p,chistat,u,lL_eba,lL_sat,fit,cova] = OptiPt(M,A,s) estimates
%   parameters, checks the goodness of fit, computes the scale values,
%   reports the log-likelihoods of the model specified in A and of the
%   saturated model, returns the fitted values and the covariance
%   matrix of the parameter estimates. If defined, s is the starting
%   vector for the estimation procedure. Otherwise each starting value
%   is set to 1/length(p).
%   The minimization algorithm used is FMINSEARCH.
%
%   Examples
%     Given the matrix M = 
%                            0    36    35    44    25
%                           19     0    31    37    20
%                           20    24     0    46    24
%                           11    18     9     0    13
%                           30    35    31    42     0
%
%     A BTL model is specified by A = {[1];[2];[3];[4];[5]}
%     Parameter estimates and the chi2 statistic are obtained by
%       [p,chistat] = OptiPt(M,A)
%
%     A Pretree model is specified by A = {[1 6];[2 6];[3 7];[4 7];[5]} 
%     A starting vector is defined by s = [2 2 3 4 4 .5 .5]
%     Parameter estimates, the chi2 statistic, the scale values, the
%     log-likelihoods of the Pretree model and of the saturated model,
%     the fitted values, and the covariance matrix are obtained by
%       [p,chistat,u,lL_eba,lL_sat,fit,cova] = OptiPt(M,A,s)
%
% Authors: Florian Wickelmaier (wickelmaier@web.de) and Sylvain Choisel
% Last mod: 03/JUL/2003
% For detailed information see Wickelmaier, F. & Schmid, C. (2004). A Matlab
% function to estimate choice model parameters from paired-comparison data.
% Behavior Research Methods, Instruments, and Computers, 36(1), 29-40.

I = length(M);  % number of stimuli
mmm = 0;
for i = 1:I
  mmm = [mmm max(A{i})];
end
J = max(mmm);  % number of pt parameters
if(nargin == 2)
  p = ones(1,J)*(1/J);  % starting values
elseif(nargin == 3)
  p = s;
end

for i = 1:I
  for j = 1:I
    diff{i,j} = setdiff(A{i},A{j});  % set difference
  end
end

p = fminsearch(@ebalik,p,optimset('Display','iter','MaxFunEvals',10000,...
    'MaxIter',10000),M,diff,I);  % optimized parameters
lL_eba = -ebalik(p,M,diff,I);  % likelihood of the specified model

lL_sat = 0;  % likelihood of the saturated model
for i = 1:I-1
  for j = i+1:I
    lL_sat = lL_sat + M(i,j)*log(M(i,j)/(M(i,j)+M(j,i)))...
                    + M(j,i)*log(M(j,i)/(M(i,j)+M(j,i)));
  end
end

fit = zeros(I);  % fitted PCM
for i = 1:I-1
  for j = i+1:I
    fit(i,j) = (M(i,j)+M(j,i))/(1+sum(p(diff{j,i}))/sum(p(diff{i,j})));
    fit(j,i) = (M(i,j)+M(j,i))/(1+sum(p(diff{i,j}))/sum(p(diff{j,i})));
  end
end

chi = 2*(lL_sat-lL_eba);
df =  I*(I-1)/2 - (J-1);
chistat = [chi df];  % 1-chi2cdf(chi,df)];  % goodness-of-fit statistic

u = sum(p(A{1}));  % scale values
for i = 2:I
  u = [u sum(p(A{i}))];
end

H = hessian('ebalik',p',M,diff,I);
C = inv([H ones(J,1); ones(1,J) 0]);
cova = C(1:J,1:J);
end

function lL_eba = ebalik(p,M,diff,I)  % computes the likelihood

if min(p)<=0  % bound search space
  lL_eba = inf;
  return
end

thesum = 0;
for i = 1:I-1
  for j = i+1:I
    thesum = thesum + M(i,j)*log(1+sum(p(diff{j,i}))/sum(p(diff{i,j})))...
                    + M(j,i)*log(1+sum(p(diff{i,j}))/sum(p(diff{j,i})));
  end
end
lL_eba = thesum;
end

function H = hessian(f,x,varargin)  % computes numerical Hessian
% based on a solution posted on Matlab Central by Paul L. Fackler

k = size(x,1);
fx = feval(f,x,varargin{:});
h = eps.^(1/3)*max(abs(x),1e-2);
xh = x+h;
h = xh-x;
ee = sparse(1:k,1:k,h,k,k);

g = zeros(k,1);
for i = 1:k
  g(i) = feval(f,x+ee(:,i),varargin{:});
end

H = h*h';
for i = 1:k
  for j = i:k
    H(i,j) = (feval(f,x+ee(:,i)+ee(:,j),varargin{:})-g(i)-g(j)+fx)...
                 / H(i,j);
    H(j,i) = H(i,j);
  end
end
end

function [S,W,Pext,dE] = cueWeightOpti(predCue,actual,Erange,Eoffset,InteractionIds)
% optimization routine for cue-specific sensitivities S and optimal
% weighting W of cues. Make sure that actual matches the dimension of each
% cue-specific cell of predCue.

% Definitions of functions
f_cue2E = @(s,cue) cue2E(s,cue,Erange,Eoffset);
f_predErr = @(p) nanrms(p(:)-actual(:)) / (Erange-Eoffset);

% optimize sensitivities
Ncues = length(predCue);
S = ones(Ncues,1); % sensitivity to cue
Pext = cell(Ncues+1,1);
dE = nan(Ncues+1,1);
predE = nan(length(predCue{1}(:)),Ncues);
for cc = 1:Ncues
  if not(all(isnan(predCue{cc}(:))))
    S(cc) = fminsearch(@(s) f_predErr(f_cue2E(s,predCue{cc})) ,S(cc));
% splot = logspace(log10(S(cc))-1,log10(S(cc))+1,100);
% for ii = 1:length(splot)
%   Eplot(ii) = f_predErr(f_cue2E(splot(ii),predCue{cc}));
% end
% figure; semilogx(splot,Eplot)
  end
  
  Pext{cc} = f_cue2E(S(cc),predCue{cc});
  predE(:,cc) = Pext{cc}(:);
  dE(cc) = f_predErr(predE(:,cc)); % mean(abs( predE(:,cc) - actual )) / (Erange-Eoffset);
end

% optimize weighting
W = zeros(size(S)); % weighting of cue
isan = not(all(isnan(predE)));
Wtmp = abs( fminsearch(@(w) f_predErr(predE(:,isan) * abs(w)./sum(abs(w))),W(isan)) ); %rms( predE * abs(w)./sum(abs(w)) - actual ),W) );
Wtmp = Wtmp/sum(Wtmp);
dE(cc+1) = f_predErr(predE(:,isan)*Wtmp);
W(isan) = Wtmp;

% Combined externalization score
dimCues = ndims(Pext{1})+1;
Pext{Ncues+1} = W(1)*Pext{1};
for cc = 2:Ncues
  Pext{Ncues+1} = nansum(cat(dimCues,Pext{Ncues+1},W(cc)*Pext{cc}),dimCues);
end

% Interaction term
dE(cc+2) = f_predErr(sqrt(predE(:,InteractionIds(1)).*predE(:,InteractionIds(2))));
Pext{Ncues+2} = sqrt(Pext{InteractionIds(1)}.*Pext{InteractionIds(2)});

end

function E = cue2E(s,cue,Erange,Eoffset)
E = Erange * exp(-cue/s) + Eoffset;
end

function y = nanrms(x)
id = not(isnan(x));
y = rms(x(id));
end