https://github.com/kperros/SPARTan
Raw File
Tip revision: 1d2d8742adf1030feb08ebc71f60491ea41ebe94 authored by Ioakeim (Kimis) Perros on 26 May 2017, 02:32:31 UTC
Delete README.txt
Tip revision: 1d2d874
parafac2_sparse_paper_version.m
function [H,A,C,P,fit,ITER_TIME,AddiOutput]=parafac2_sparse_paper_version(X,F,Constraints,Options,H,A,C,P)
% This code contains the core part of the fitting algorithm for the PARAFAC2 model.
% It is parameterized to run either the SPARTan or the baseline approach.
% We accredit the dense PARAFAC2 implementation by Rasmus Bro (http://www.models.life.ku.dk/algorithms), from where we have adapted many functionalities.

ShowFit  = 5; % Show fit every 'ShowFit' iteration
NumRep   = 10; %Number of repetead initial analyses
NumItInRep = 80; % Number of iterations in each initial fit
if ~(length(size(X))==3||iscell(X))
    error(' X must be a three-way array or a cell array')
end

if nargin < 4
    Options = zeros(1,5);
end
if length(Options)<5
    Options = Options(:);
    Options = [Options;zeros(5-length(Options),1)];
end
BASELINE = ~Options(6);% Choice of algorithm
PARFOR_FLAG = Options(7);

% Convergence criterion
if Options(1)==0
    ConvCrit = 1e-7;
else
    ConvCrit = Options(1);
end
if Options(5)==0
    disp(' ')
    disp(' ')
    disp([' Convergence criterion        : ',num2str(ConvCrit)])
end

% Maximal number of iterations
if Options(2)==0
    MaxIt = 2000;
else
    MaxIt = Options(2);
end

% Initialization method
initi = Options(3);

if nargin<3
    Constraints = [0 0];
end
if length(Constraints)~=2
    Constraints = [0 0];
    disp(' Length of Constraints must be two. It has been set to zeros')
end
ConstraintOptions=[ ...
    'Fixed                     ';...
    'Unconstrained             ';...
    'Non-negativity constrained';...
    'Orthogonality constrained ';...
    'Unimodality constrained   ';...
    'Not defined               ';...
    'Not defined               ';...
    'Not defined               ';...
    'Not defined               ';...
    'Not defined               ';...
    'Not defined               ';...
    'GPA                       '];

if Options(5)==0
    disp([' Maximal number of iterations : ',num2str(MaxIt)])
    disp([' Number of factors            : ',num2str(F)])
    disp([' Loading 2. mode, A           : ',ConstraintOptions(Constraints(1)+2,:)])
    disp([' Loading 3. mode, C           : ',ConstraintOptions(Constraints(2)+2,:)])
    disp(' ')
end


% Make X a cell array if it isn't
if ~iscell(X)
    for k = 1:size(X,3)
        x{k} = X(:,:,k);
    end
    X = x;
    clear x
end
I = size(X{1}, 2);
K = max(size(X));
for k=2: K
    assert(size(X{k}, 2)==I);
end

% Initialize
if nargin<5
    assert(initi~=0);
    if initi==1 % Initialize by SVD
        if Options(5)==0
            disp('SVD based initialization')
        end
        
        XtX=full(X{1}'*X{1});
        if (PARFOR_FLAG)
            parfor k=2: K
                XtX = XtX + X{k}'*X{k};
            end
        else
            for k=2: K
                XtX = XtX + X{k}'*X{k};
            end
        end
        sumdiag_xtx = sum(diag(XtX));
        
        [A,~,~]=svd(XtX, 0);
        if (Constraints(1)==1)
            A = abs(A);
        end
        A=A(:,1:F);
        C=ones(K,F)+randn(K,F)/10;
        if (Constraints(2)==1)
            C = abs(C);
        end
        H = eye(F);
    elseif initi==2
        if Options(5)==0
            disp(' Random initialization')
        end
        A = rand(I,F);
        C = rand(K,F);
        H = eye(F);
    else
        error(' Options(2) wrongly specified')
    end
end

if initi~=1
    diag_xtx = cellfun(@(x) full(diag(x'*x)), X, 'UniformOutput',false);
    sumdiag_xtx = sum(cellfun(@sum, diag_xtx));
end
fit    = sumdiag_xtx;%sum(diag(XtX));
oldfit = fit*2;
fit0   = fit;
it     = 0;

if Options(5)==0
    disp(' ')
    disp(' Fitting model ...')
    disp(' Loss-value      Iteration     %VariationExpl')
end

tic;
% Iterative part
while abs(fit-oldfit)>oldfit*ConvCrit && it<MaxIt && fit>1000*eps
    oldfit = fit;
    it   = it + 1;
    
    % Update P
    P = cell(K, 1);
    YY = cell(K, 1);
    if (PARFOR_FLAG)
        parfor k = 1:K
            Qk = H*diag(C(k,:))*(X{k}*A)';%(A'*X{k}');
            P{k} = Qk'*psqrt(Qk*Qk');
            YY{k} = sparse(P{k}'*X{k});
        end
    else
        for k = 1:K
            Qk = H*diag(C(k,:))*(X{k}*A)';%(A'*X{k}');
            P{k} = Qk'*psqrt(Qk*Qk');
            YY{k} = sparse(P{k}'*X{k}); 
        end
    end
    
    if (BASELINE) %creation of the sptensor is necessary only for the baseline
        spY = permute( sptensor( sptenmat(cell2mat(YY), [1 2], 3, [F, K, I]) ) , [1, 3, 2]); % assert(isequal(double(tensor(spY)), Y));
    end
    
    % Update A,H,C using PARAFAC-ALS
    if (BASELINE)
        spCP = cp_als_for_parafac2_baseline(spY, F, 'init', {[], A, C}, 'maxiters', 1, 'printitn', 0, 'Constraints', Constraints, 'PARFOR_FLAG', PARFOR_FLAG);
        %[Bro_H, Bro_A, Bro_C, Bro_ff]=parafac(reshape(Y,F,I*K),[F I K],F,1e-4,[ConstB Constraints(1) Constraints(2)],H, A, C, 1); %caution, has to adjusted/permuted
        %Bro_CP = ktensor({Bro_H, Bro_A, Bro_C});
    else
        spCP = cp_als_for_parafac2(YY, F, 'init', {[], A, C}, 'maxiters', 1, 'printitn', 0, 'Constraints', Constraints, 'PARFOR_FLAG', PARFOR_FLAG);
    end
    
    spCP = arrange(spCP, 1);
    H = spCP.U{1}; A = spCP.U{2}; C = spCP.U{3};
    fit = parafac2_fit(X,H,A,C,P,K, PARFOR_FLAG);
    
    if rem(it,ShowFit)==0||it == 1 % Print interim result
        if Options(5)==0
            fprintf(' %12.10f       %g        %3.4f \n',fit,it,100*(1-fit/fit0));
        end
    end
end
ITER_TIME = toc;

if rem(it,ShowFit)~=0 %Show final fit if not just shown
    if Options(5)==0
        fprintf(' %12.10f       %g        %3.4f \n',fit,it,100*(1-fit/fit0));
    end
end


function X = psqrt(A,tol)
% Produces A^(-.5) even if rank-problems

[U,S,V] = svd(A,0);
if min(size(S)) == 1
    S = S(1);
else
    S = diag(S);
end
if (nargin == 1)
    tol = max(size(A)) * S(1) * eps;
end
r = sum(S > tol);
if (r == 0)
    X = zeros(size(A'));
else
    S = diag(ones(r,1)./sqrt(S(1:r)));
    X = V(:,1:r)*S*U(:,1:r)';
end



back to top