fttpls01.m

Tucker, PARAFAC, GRAM, RAFA and misc. 2nd order models with a test data set (old version now covered

function [T,Wj,Wk,U,Q,B]=fttpls01(X,Y,r1,r2,r3,W,convlim);
%function [T,Wj,Wk,U,Q,B]=fttpls01(X,Y,r1,r2,r3,W,convlim);
%
%This tri-linear PLS program decomposes X into W triads while 
%maximizing the covariance between the sucessive scores
%and Y. The procedure has been implemented as proposed
%by Bro (1995)
%
%This particular procedure (fttpls01) pertains no constraints at all.
% 
% X        : Supermatrix (r1 x r2穜3) from cube (r1 x r2 x r3).
% Y        : Matrix (r1 x ry)
% r1,r2,r3 : Number of observations along each way.
% W        : Number of factors.
% convlim  : Max. difference between two succesive sq. sums of misfits.
%            Default set to 1.0e-8 
% T        : Scores of objects in X (r1 x W)
% Wj       : Loadingweights along r2 (r2 x W)
% Wk       : Loadingweights along r3 (r3 x W)
% U        : Scores of objects in Y (r1 x W)
% Q        : Loadings along ry in Y (ry x W)
% B        : Regression coefficients for the model (W x W)
%
% Author   : Claus A. Andersson, May 1995 
% Copyright: Food Technology,
%            Royal Veterinary & Agricultural University
%            Copenhagen, Denmark
% E-mail   : [e-mail]
%
% Rev.       Error in PLS1-functionality, Thanks to Lisbeth, 22-7-97, CA


if ~exist('convlim')|convlim<eps,
  convlim=1e-8;
end;
[r1 ry]=size(Y);
Xr=X;
Yr=Y;
Xp=zeros(r1,r2*r3);
T=zeros(r1,W);
Wj=zeros(r2,W);
Wk=zeros(r3,W);
U=zeros(r1,W);
Q=zeros(ry,W);
B=zeros(W,W);
for w=1:W,
  if ry==1,
    u=Yr;
  else
    [u]=fnipals1(Yr,1);
  end;
  it=0;
  oldu=u;
  converged=0;
  while converged==0,
    it=it+1;

    %Calculate T and Wj and Wk for X
    Z=reshape((Xr'*u),r2,r3);
    [wj,wk] = fnipals1(Z,1);
    wj=wj/norm(wj);
    wk=wk/norm(wk);
    wt=reshape(wj*wk',r2*r3,1)';
    T(:,w)=Xr*wt';
    Wj(:,w)=wj;
    Wk(:,w)=wk;

    %Calculate Q and U for Y
    q=T(:,w)'*Yr;
    q=q'/norm(q);
    Q(:,w)=q;
    u=Yr*q;
    U(:,w)=u;

    diff=sum((u-oldu).^2)/sum(u.^2);
    if diff<=convlim,
      converged=1;
    end;
    oldu=u;

  end

  B(1:w,w)=(T(:,1:w)'*T(:,1:w))\T(:,1:w)'*U(:,w);

  fprintf('Have found %i factors of %i. \n',w,W);

  Xp=Xp+T(:,w)*wt;
  Xr=X-Xp;
  Yr=Y-T(:,1:w)*B(1:w,1:w)*Q(:,1:w)';

end

if it>=299
  disp('Message from fttpls01 : Did not converge!')
end

disp('FTTPLS01: Execution ended.')