function res = RrepAnova(sbj,betvar,withvar,data,labels,varargin)
%
% res = RrepAnova(sbj,betvar,withvar,data,labels,...)
% 
% WindowsまたはLinux環境でMatlab/OctaveからRのrepAnova()を実行します。
% Rscript(Rscript.exe)にパスが通っていて、Rの起動時にanovakun()と
% repAnova()を読みこむように設定されている必要があります。
%
% 引数
% sbj
%   被験者を示すラベルが収められたn行×1列のセル配列を指定します。
%   nは全データ数です。
% betvar
%   被験者間要因の水準を示すラベルが収められたn行×b列のセル配列を
%   指定します。nは全データ数、bは被験者間要因の個数です。
%   被験者間要因がない場合は[]を指定します。
% withvar
%   被験者内要因の水準を示すラベルが収められたn行×w列のセル配列を
%   指定します。nは全データ数、wは被験者内要因の個数です。
%   被験者内要因がない場合は[]を指定します。
% data
%   従属変数の値を格納したn行×1列の配列を指定します。
%   nは全データ数です。
% labels
%   被験者、被験者間要因、被験者間要因、従属変数のデータ列につける
%   ラベルを格納した1行L列のセル配列を指定します。Lはb+w+2です。
%   
% オプション
%   repAnova()に渡すオプションを'オプション名','値'の対で列挙します。
%   repAnova()を実行する時に " " が必要な値は'" "'と書きます。
%   例：titleに"error rateの比較"と指定したい
%     RrepAnova( <中略> , 'title', '"error rateの比較"')
%   
% 変更履歴
% 2010/3/23
% ・LinuxのOctaveからの実行できるように修正。
%   WindowsのOctaveやLinuxのMatlabからでも呼べるはず（未確認）。
% ・Rscriptを呼び出す行の" "がマッチしていなかった点を修正。
% 
% 2010/3/12
% ・最初の公開
% 
% 作者
%   十河宏行(愛媛大学法文学部)
%   http://www.s12600.net/psy/
% お断り
%   この関数の使用によって生じるいかなる結果に関しても責任を
%   負いかねます。
% 

%オプションの処理
options = '';
if ~isempty(varargin)
    if mod(length(varargin),2)~=0
        error('Options must be paired.')
    end
    for i=1:(length(varargin)/2)
        options = [options ',' varargin{2*i-1} '=' escapebs(varargin{2*i})];
    end
end

f = tempname;

%ファイルを作成する
%まずファイルをオープン
fid = fopen(f,'w');

%列名を出力
for li=1:length(labels)-1
    fprintf(fid,'%s\t',labels{li});
end
fprintf(fid,'%s\n',labels{end});

for di = 1:length(sbj)
    %sの出力
    fprintf(fid,'%s',num2str(sbj{di}));
    
    %betvarの出力
    if ~isempty(betvar)
        if size(betvar,2)==1
            fprintf(fid,'\t%s',num2str(betvar{di}));
        else
            for i=1:size(betvar,2)
                fprintf(fid,'\t%s',num2str(betvar{di,i}));
            end        
        end
    end
    
    %withvarの出力
    if ~isempty(withvar)
        if size(withvar,2)==1
            fprintf(fid,'\t%s',num2str(withvar{di}));
        else
            for i=1:size(withvar,2)
                fprintf(fid,'\t%s',num2str(withvar{di,i}));
            end
        end
    end
    
    %dataの出力
    fprintf(fid,'\t%f\n',data(di));
end

fclose(fid);


%repAnovaに渡す文字列を作成
idx = 1;
rAargs = ['d,\"' labels{idx} '\",'];
if isempty(betvar)
    rAargs = [rAargs 'NULL,'];
else
    if size(betvar,2)==1
        idx = idx+1;
        rAargs = [rAargs '\"' labels{idx} '\",'];
    else
        rAargs = [rAargs 'c('];
        for i=1:size(betvar,2)-1
            idx = idx+1;
            rAargs = [rAargs '\"' labels{idx} '\",'];
        end
        idx = idx+1;
        rAargs = [rAargs '\"' labels{idx} '\"),'];
    end
end
if isempty(withvar)
    rAargs = [rAargs 'NULL,'];
else
    if size(withvar,2)==1
        idx = idx+1;
        rAargs = [rAargs '\"' labels{idx} '\",'];
    else
        rAargs = [rAargs 'c('];
        for i=1:size(withvar,2)-1
            idx = idx+1;
            rAargs = [rAargs '\"' labels{idx} '\",'];
        end
        idx = idx+1;
        rAargs = [rAargs '\"' labels{idx} '\"),'];
    end
end
idx = idx+1;
rAargs = [rAargs '\"' labels{idx} '\"'];

%デバッグ用
%['repAnova(' rAargs options ')']
%['Rscript --default-packages=stats,utils,methods -e "d<-read.table(\"' f '\",header=T); repAnova(' rAargs options ')"']

if isunix
    status = system(['Rscript --default-packages=stats,utils,methods -e "d<-read.table(\"' f '\",header=T); repAnova(' rAargs options ')"']);
    system(['rm ', f]);
else
    df = dupfilesep(f);
    status = system(['Rscript --default-packages=stats,utils,methods -e "d<-read.table(\"' df '\",header=T); repAnova(' rAargs options ')"']);
    system(['del ', f]);
end
res = status;


function df = dupfilesep(f)
df = [];
for i=1:length(f)
    if(f(i)==filesep)
        df = [df filesep filesep];
    else
        df = [df f(i)];
    end
end

function es = escapebs(s)
es = [];
for i=1:length(s)
    if(s(i)=='"')
        es = [es '\"'];
    else
        es = [es s(i)];
    end
end

